エクセル 入力について

お尋ねしたいです。
エクセルで、入力用シートから別表シートにＶＢＡでデータ入力しています。
しかし表の最下列にデータがあると、上書きされてしまい前のデータが失われてしまう、
という入力ミスが多く、困っています。

そこで表の最下列セルに何か入力されているか、下から２番目のセルが空白セルの場合に、入力できないかエラーがでるようにしたいのですが、
ＶＢＡなどを使えば、出来るのでしょうか？

説明が分かりにくければすみません。。
お願い致します。

No.3 ベストアンサー 回答者： n-jun 回答日時： 2007/10/10 16:23

別表が

>Set ws1 = Worksheets("顧客データ")
である場合、最終行＋１にしたいのなら、
>Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0)
Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(1)
オフセットで１つ下にしてあげればいいはずです。
（０では最終行に書き込んでしまいます）

この回答への補足

ありがとうございます。
すみません説明不足で。。
表はすでに用意されている訳ではなく、一行ずつ増やして作成していくので、はじめに

　　＞Worksheets("顧客データ").Select
　　　Range("テーブル1[[#Headers],[ＮＯ．]]").Select
Selection.End(xlToRight).Select
Selection.End(xlDown).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=False
　Range("B7").Select
を入れたら大丈夫になりました。

この場合２つ下や３つ下に書き込んでしまった場合、顧客番号が狂ってくるので
エラー表示が出るようにしたいのですが、このコード内に収められるのでしょうか？

あと、ＶＢＡに他のＶＢＡを作動させないと作動できないという関数の条件分岐のような命令は下せるのでしょうか・・・？

補足日時：2007/10/11 10:20

この回答へのお礼

色々とお答えいただき、ありがとうございました。
無事、解決致しました。

また機会があればよろしくお願い致します。

お礼日時：2007/10/12 12:20

No.2 回答者： imogasi 回答日時： 2007/10/10 13:38

質問の意味が判りにくい

＞最下列セルに何か入力されているか、下から２番目のセルが空白セルの場合
最下列は最下行のミスか？
最下行として、最下行と言ってながら、下から２番目のセル、とは？
ーー
＞表の最下列にデータがあると、入力シートのほうか、累積？転記？シートのほうか？
＞表の最下列にデータがあると、
転記する（受け）シートのことらしいが、＞表の最下列にデータがあると、上書きされてしま、とはコードの組み方が悪いというだけの話じゃないの。いつもこうなると言うようなことがエクセルにありますか。無いと思うので、コードのロジックの不都合を指摘してほしい質問か、別のこと（エクセルでは普通こうなるが、それではイヤなので、こうしたいというような）かはっきりさせるべきです。
ーー
実例でも挙げないと、様子がわからないし、
回答でコードを書くとなると、シート名、行番号、列番号を決め（まら）ないとコードは書けないのは、経験しているでしょう。
ーー
今コードがあって長くないなら、掲出してみては。

この回答への補足

＞最下列は最下行のミスか？
すみません、最下行です。
＞最下行として、最下行と言ってながら、下から２番目のセル、とは？
データが入力されている、最下行のセルのひとつ下に入力したいということを言いたかったのですが、ややこしくしてしまい申し訳ないです。

分かりにくい説明で本当にすみません、このコードに、入力の際に蓄積させる表を一行増やさせる方法もありますね。

下にコード貼っておきます。

「"承認書作成"シートで入力したものが"顧客データ"シートに転記させ、そこで顧客番号が発行されたものを"承認通知書"シートに転記させる」
という命令をしたものです。

Sub 転記()

Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range
Dim i As Long
Dim nyuryoku(), chikuseki()

Set ws0 = Worksheets("承認書作成")
Set ws1 = Worksheets("顧客データ")
Set ws2 = Worksheets("業者コード")
Set ws3 = Worksheets("承認通知書")

nyuryoku = Array("b5", "d5", "f5", "h5", "j5", "l5", "n5", "p5", "b6", "d6", "f6", "h6", "j6", "l6", "n6", "p6", "b4", "d4")
'転記したいセルの位置

chikuseki = Array("0", "1", "5", "6", "8", "9", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "53", "54")

'転記先の列のオフセット値
Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0)
'データ蓄積セル
　　 For i = 0 To UBound(nyuryoku)
r1.Offset(0, chikuseki(i)).Value = ws0.Range(nyuryok(i)).Value
Next
MsgBox "入力完了"

　　Dim lRowNum As Long
　'転記先となる行番号を求める
lRowNum = ws1.Cells(Rows.Count, "b").End(xlUp).Row
　'転記
ws3.Cells(6, "d").Value = ws1.Cells(lRowNum, "j").Value
ws3.Cells(9, "d").Value = ws1.Cells(lRowNum, "ej").Value
ws3.Cells(9, "q").Value = ws1.Cells(lRowNum, "ek").Value

ws3.Cells(17, "g").Value = ws1.Cells(lRowNum, "c").Value
ws3.Cells(22, "g").Value = ws1.Cells(lRowNum, "l").Value
ws3.Cells(22, "ac").Value = ws1.Cells(lRowNum, "ab").Value
ws3.Cells(24, "g").Value = ws1.Cells(lRowNum, "bh").Value
ws3.Cells(25, "g").Value = ws1.Cells(lRowNum, "bg").Value
ws3.Cells(24, "ac").Value = ws1.Cells(lRowNum, "q").Value
ws3.Cells(24, "ao").Value = ws1.Cells(lRowNum, "r").Value
ws3.Cells(27, "g").Value = ws1.Cells(lRowNum, "ac").Value
ws3.Cells(30, "g").Value = ws1.Cells(lRowNum, "ea").Value

Set ws0 = Nothing
Set ws1 = Nothing
End Sub

補足日時：2007/10/10 14:36

この回答へのお礼

無事、解決致しました、ありがとうございました。

また機会があればよろしくお願い致します。

お礼日時：2007/10/12 12:20

No.1 回答者： n-jun 回答日時： 2007/10/10 12:40

>表の最下列にデータがあると

別表シートの”最終行”の事でしょうか？

その場合、別表シートはデータを蓄積する範囲が決まっており、
それ以上（最終行より下）はデータを追加したくない、
と言う事ですか？

入力用シートと別表シートのレイアウトを提示されては？

この回答への補足

迅速なご回答ありがとうございます。

>別表シートの”最終行”の事でしょうか？
”最終行”のことです。すみません。

別シートの表の構成は　列がＢ列からＥＫ列までの116の項目があります。
行は各顧客情報になっており、顧客のデータを蓄積していくたびに下に増えていきます。
顧客情報の書類がとどいた際に、その表の何項目かだけを手早く入力したいので、18項目の情報を　別シートの入力用セルから表に転記できるようになっています。

その入力の際、顧客番号が発行されるのですが、表の関数によって作られます。なので、ひとつ前の顧客の情報の一行下に入力しないといけません。
そして転記は、別シートの表の一番最下行に入力されるので、表を一行増やしておかないと前のデータにかぶって入力されてしまうのです。

なので、入力用セルから入力後、転記される際に別シートの表に一行の空白行が表示されていないと入力できなくするか、エラーがでるかの処理をしたいのです。

説明が下手なうえに、ややこしくてすみません。
どうかお願い致します。

補足日時：2007/10/10 14:05