エクセルで作った表へ自動入力したい

例えば、１００世帯のマンションがあります。エクセルの行に００１～１００までの世帯番号を、列に何月分かを列記した管理表を作ります。
別のシートに、例としてＭ１に世帯番号を、Ｍ２に貰った家賃が何月分かを、Ｍ３に家賃を貰った日付を入力して日報を作ると、自動的に管理表の座標を探してＭ３の日付が入力するようにしたいと質問したら、

一般機能では無く、マクロ処理になりますね。
1.[Alt]+[F11]　で Ｖｉｓｕａｌ Ｂａｓｉｃ Ｅｄｉｔｏｒ を起動し、[挿入]-
　 [標準モジュール] で開く画面に、次の３行をコピペします。
　　Sub TEST()
　　　Range(Range("M1") & Range("M2")) = Range("M3")
　　End Sub
2.Ｍ列各セルに、次の内容を入力します。
　　M1：列記号を入力（ 入力例：C ）
　　M2：行番号を入力（ 入力例：4 ）
　　M3：データを入力（ 入力例：テスト ）
3.[ツール]-[マクロ]-[マクロ] から　TEST　を選択して実行します。　
　　　→Ｃ４に　テスト　と入力されます。
　 M1:M3 に入力してマクロを実行するたびに、指定されたセルに書き込まれます。
との答えを頂きました。しかし日報の様に使いたいので、Ｍ列だけで無くＮ、Ｌ、Ｏと列記して次々と管理表に入力出来る様にしたいのです。どの列でも、１に世帯番号を、２に何月分かを、３に領収日を入力すれば、自動的に管理表に入力されるようにしたいのです。宜しくお願いします。

No.1 回答者： noname#22222 回答日時： 2006/02/04 11:12

＜集金データ入力表＞

[入力列名前]_______M___________|________N___________|_______O___________|________P___________|・・・
[家賃の月次]___________________2|___________________2|___________________2|___________________2|・・・
[世帯別番号]___________________1|___________________2|___________________3|___________________4|・・・
[入金年月日]___2006/02/10|___2006/02/10|____________________|_____________________|・・・

このような＜集金データ入力表＞を用意し、[入金年月日]が入力する。
そうすると、次のような＜マンション家賃管理表＞に自動的に転記される。

＜マンション家賃管理表＞

[世帯行番号] ______1月分_____| ______2月分_____| ______3月分_____|
________________1|___2006/01/20|__2006/02/10|_____________________|
________________2|___2006/01/20|__2006/02/10|_____________________|
________________3|___2006/01/22|____________________|_____________________|

質問は、このように解釈して宜しいでしょうか?

＜確認＞

・入力後に、いちいちマクロを操作するのは手間だと思います。
・ですから、VBAで[入金年月日]を監視し、それが更新されたら＜マンション家賃管理表＞も更新されるという仕組みが最適かと思います。

※Excel は、一度しか利用したことのない門外漢ですが、これは私にも可能なようです。
※質問者は、当方が提示したモジュールコードをコピーするだけでOKと思われます。
※こういうやり方でよければ、ちょこっと作成してみようと思います。

この回答へのお礼

有難う御座います。その通りです、でも私にはそんなに簡単でもないですけれど、助かります。

お礼日時：2006/02/05 17:41

No.2 回答者： seiya0422PP 回答日時： 2006/02/04 11:25

まず、Rangeコマンドではセルの指定が大変です。

Cells（行、列）
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2006/2/4 ユーザー名 :
'
Dim gyo As Integer
Dim tuki As Integer
Dim hi1 As Integer
Dim hi2 As Integer
Dim hi3 As Integer
For i = 1 To 3
Sheets("data").Select
gyo = 0
tuki = 0
hi = 0
gyo = Cells(i + 1, 1)
MsgBox (gyo)
If (Not gyo) Then
tuki = Cells(i + 1, 2)
MsgBox (tuki)
hi1 = Year(Cells(i + 1, 3))
hi2 = Month(Cells(i + 1, 3))
hi3 = Day(Cells(i + 1, 3))
MsgBox (hi)
Sheets("hyou").Select
Cells(gyo, 2) = tuki
Cells(gyo, 3) = (hi1)
Cells(gyo, 4) = (hi2)
Cells(gyo, 5) = (hi3)
End If
Next i
9000
End Sub
dataというシートに何号の何月分をいつといった感じ
のシートを用意し
hyouというシートに１から１００世帯といった感じ。
以上です。

No.3 回答者： noname#22222 回答日時： 2006/02/04 12:22

入力するシートのラベルを右クリックして[コード]の表示をクリックします。

次のコードをコピーします。

Private Sub Worksheet_Change(ByVal Target As Range)
End Sub

の部分は、コピーしないで[Worksheet]-[Change]を選んで自動生成させて下さい。

（注意）エラー処理が完璧ではありませんので、入力ミスの場合は注意が必要です。

Option Explicit
Dim isInput As Boolean　　　　' True=入金日入力中、False=入金日非入力中
Dim R As Integer　　　　　　　　' 選ばれた行番号
Dim C As Integer　　　　　　　　' 選ばれた列番号
Dim dteHiduke_Now As Date ' 入力される[入金日]の既定値
Dim dteHiduke_New As Date　 ' 新しく入力された[入金日]
Const 入金日入力行 = 3　　　　' [入金日]を入力する行の番号
Const 入金日開始列 = 13　　　 ' [入金日]を入力する列の開始番号
Const 入金日終了列 = 112　　　' [入金日]を入力する列の終了番号
Const 更新行_Offset = 1　　　　 ' 入力する[世帯行番号]と更新行との差
Const 更新列_Offset = 1　　　　 ' 入力する[何月分]と更新列との差

Private Sub Worksheet_Change(ByVal Target As Range)
ON Error Resume Next
　　Dim Update_R As Integer
　　Dim Update_C As Integer
　　
　　If isInput Then
　　　　If Len(Cells(R, C) & "") > 0 Then
　　　　　　dteHiduke_New = Cells(R, C)
　　　　Else
　　　　　　dteHiduke_New = "1900/01/01"
　　　　End If
　　　　If dteHiduke_New <> dteHiduke_Now Then
　　　　　　Update_R = Cells(R - 2, C) + 更新行_Offset
　　　　　　Update_C = Cells(R - 1, C) + 更新列_Offset
　　　　　　If dteHiduke_New <> "1900/01/01" Then
　　　　　　　　Worksheets("家賃管理表").Cells(Update_R, Update_C) = dteHiduke_New
　　　　　　Else
　　　　　　　　Worksheets("家賃管理表").Cells(Update_R, Update_C) = ""
　　　　　　End If
　　　　End If
　　End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ON Error Resume Next
　　R = Target.Row
　　C = Target.Column
　　If R = 入金日入力行 And (C >= 入金日開始列 And C <= 入金日終了列) Then
　　　　isInput = True
　　　　If Len(Cells(R, C) & "") > 0 Then
　　　　　　dteHiduke_Now = Cells(R, C)
　　　　Else
　　　　　　dteHiduke_Now = "1900/01/01"
　　　　End If
　　Else
　　　　isInput = False
　　End If
End Sub

No.4 ベストアンサー 回答者： imogasi 回答日時： 2006/02/04 12:47

過去の回答を横においておいて、下記をやってみてください。

ーーーーーー
＜管理表＞Sheet１　下記例では１－４月までにしてます。
C1に１、D1に２、C1:D1を範囲指定し＋ハンドルをオートフィルで引っ張って１から１２まで入れる。１年１２か月分。書式はユーザー定義「＃月分」にする。
A１からA100まで所帯番号を入れる。B2に番号に対応した所帯主名（または姓）を入れる。
C2:N100の書式は、日付書式を設定する。
(例）日付は下記処理結果
１月２月３月４月
1山田2006/2/42006/2/4
2大木2006/2/4
3小川2006/2/4
5鈴木2006/3/1
7田中
ーーーー
＜収納（受入）日報＞　Sheet2
（例）
12345
世帯番号13215
名前山田小川大木山田鈴木
何月分2月分4月分2月分1月分3月分
日付2006/2/42006/2/42006/2/42006/2/42006/3/1
記帳記帳済記帳済記帳済記帳済記帳済
第１行　連番を振る（なくても可。
第２行　収納した所帯番号を入力する。
第３行目　B3に　=IF(B2="","",VLOOKUP(B2,Sheet1!$A$2:$B$7,2,FALSE))　を入れて右方向に式を複写する。
所帯の名前をSheet1から引っ張ってきて、表示する。
第４行目　何月分か入力する。書式はユーザー定義　「＃＃月分」
第５行目　収納日を入力。当日なら、CTRL+;が便利。
第６行目　記帳済とVBAで表示する。
Sheet２のシートモジュールで
SelectionChangeイベントモジュールに
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 6 Then
r = WorksheetFunction.Match(Target.Offset(-4, 0), Worksheets("Sheet1").Range("a1:A100"), 0)
c = Target.Offset(-2, 0)
Worksheets("Sheet1").Cells(r, c + 2) = Target.Offset(-1, 0)
MsgBox "記帳済"
Target = "記帳済"
End If
End Sub
を貼り付ける。
MsgBox "記帳済"　は要らないかも。
やっていることは、
所帯番号で、Sheet1の行を探し、ｎ月分からC=N+2を決め、
Sheet1のCells(r,c)セルに収納日をセットしている。
あとチェックルーチンなどを加えると、増えるが、原型としては
他と比べて、短いはずです（実質たった７行）。

この回答への補足

大変申し訳ありません。実用化するのに一ヶ月掛かってしまいました。できれば、Sheet2の列と行を入れ替えられれば、更に使い易くなりそうです。我儘言ってすみませんが教えてください。宜しくお願いします。

補足日時：2006/03/08 19:21

この回答へのお礼

同じような質問を何度もして、その度に回答を寄せていただいてありがとう御座います。良く分からないこともあり気分を害されたかも知れません。本当に済みませんでした。補足でも言ったのですが、一つの売り上げ(Sheet2で)を、A列に連番、B列に世帯番号、C列に名前、D列に何月分、E列に日付、F列に記帳、と行と列を入れ替えるのに試行錯誤してお礼も遅くなりました。その中で多少分かったこともあり、勉強になりました。ありがとう御座いました。

お礼日時：2006/03/11 16:25