エクセルでセルに入力した数字を指定したSheetの指定したセルに反映できますか

質問

http://okwave.jp/qa4814381.html
で質問したものです。
例として「Sheet1」のセルA1に「1111」と入力しB1に「故障」、C1に「日時」を、D1に「担当者名」を入力すると、Sheet名「1111」のB18に「故障」C18に「日時」D18に「担当者名」が反映。
その後は入力していけば、B、C、Dの19～と下に反映していく方法を教えてください。

反映させるセルは「B18」を始まりとして、そのセルに内容、「C18」に日時「D18」に担当者の名前を始まりとしたいです。

回答No.6

hige_082 · ベストアンサー

まとめましたので、前回のものと入れ替えてください

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d1")) Is Nothing Then Exit Sub
If Range("a1").Value = "" Then Exit Sub
If Range("b1").Value = "" Then Exit Sub
Dim myData As Variant
Dim i As Long
Dim flg As Integer
Dim ws As Worksheet
flg = 0
For Each ws In Worksheets
If Range("a1").Value = ws.Name Then
flg = 1
Exit For
End If
Next ws
If flg = 1 Then
myData = Range("b1:d1").Value
With Worksheets(Range("a1").Value)
i = .Range("b65536").End(xlUp).Offset(1, 0).Row
If i < 18 Then
.Range("b18:d18").Value = myData
Else
.Range("b65536").End(xlUp).Offset(1, 0).Resize(1, 3).Value = myData
End If
End With
Else
MsgBox "入力されたSheetはありません"
End If
End Sub

お礼

回答ありがとうございます。
返事が大変遅くなり申し訳ございません。

非常に役に立っています。
助かりました！

回答No.5

mu2011

NO3です。
>関数の最初と最後に{}が付きます。これで正しいのでしょうか？
⇒正しい配列数式の表示です。

>「＃REF」となってしまいました。
⇒配列数式として認識されいてエラーとなっている場合、考えられる原因として、シート名の数値・文字列による書式相違です。
　回答では、シート名を文字列としていますので、仮にA1の1111が右詰め（数値）の場合、次の数式でお試し下さい。
　=IF(COUNTIF(Sheet1!$A:$A,MID(CELL("filename"),FIND("]",CELL("filename"))+1,31)*1)>ROW(A1)-1,INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$1:$A$100=MID(CELL("filename"),FIND("]",CELL("filename"))+1,31)*1,ROW(Sheet1!$A$1:$A$100),99999),ROW(A1))),"")

お礼

回答ありがとうございます。
返事が非常に遅くなり申し訳ございません。

この数式、色々と活用させていただきます。

回答No.4

hige_082

こんばんわ、hige_082です
前回までと違い、入力するセルが増えたため処理開始の
タイミングが分からないので、今回は入力後マクロを実行する必要があります
A1～D1は必ず入力されるのでしょうか？
入力の順番は？
この辺が不明なので・・・

取り敢えずこっちで勝手に決めます
＃２のマクロはそのままで、次を追加してみてください

'対象シートモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
'ここで指定したセル(D1)に入力すると処理が開始されます
If Intersect(Target, Range("d1")) Is Nothing Then Exit Sub
'A1に入力されていないとエラーが出るので、入力されているか検査します
'空白の場合は処理を中止します
If Range("a1").Value = "" Then Exit Sub
'B1に入力されているか検査します
'空白の場合は処理を中止します
If Range("b1").Value = "" Then Exit Sub
Call test
End Sub

D1に値を入力すると処理が開始されますが
A1・B1が未入力だと処理は中止されます
勝手に決めちゃいましたが
こんな感じでよいかな

お礼

追記です。順番は上記のとおりで大丈夫です。
よろしくお願いします。

補足

いつもご親切にありがとうございます。

今回教えていただいた事を実行してみたところ
With Worksheets(Worksheets("sheet1").Range("a1").Value)
の部分が黄色く表示されて、デバックが有効でない。とエラーが出ます。

何度もお聞きして申し訳ないですが、解決の仕方をお教えください。
モジュールの知識がなく何もできません。
よろしくお願いします。

回答No.3

mu2011

一例です。（シートタブ名をキーにSheet1の入力情報を抽出としていますので、相違するようでしたら読み飛ばして下さい）

シートのB18に以下の配列数式を設定、縦横に必要分コピーして下さい。（配列数式の為、入力完了時にshift＋ctrl＋enterキーを同時押下して下さい）
因みにシート名情報は文字列として、直接シートタブから引用していますが、各シートに設定できるのであれば数式も短くなります。

=IF(COUNTIF(Sheet1!$A:$A,MID(CELL("filename"),FIND("]",CELL("filename"))+1,31))>ROW(A1)-1,INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$1:$A$100=MID(CELL("filename"),FIND("]",CELL("filename"))+1,31),ROW(Sheet1!$A$1:$A$100),99999),ROW(A1))),"")

補足

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

上記をおこなったところ「＃REF」となってしまいました。
セルに上記の関数を貼り付けて、shift＋ctrl＋enterキーを同時押ししてます。
その時に関数の最初と最後に{}が付きます。これで正しいのでしょうか？

回答No.2

hige_082

こんな感じかな？

'標準モジュールへ
Sub test()
Dim myData As Variant
Dim i As Long
myData = Worksheets("sheet1").Range("b1:d1").Value
With Worksheets(Worksheets("sheet1").Range("a1").Value)
i = .Range("b65536").End(xlUp).Offset(1, 0).Row
If i < 18 Then
.Range("b18:d18").Value = myData
Else
.Range("b65536").End(xlUp).Offset(1, 0).Resize(1, 3).Value = myData
End If
End With
End Sub

補足

回答ありがとうございます。
標準モジュールにて行いましたが、何も反映しませんでした。
自分のやり方がまちがっているのでしょうか？
標準モジュールに上記を貼り付けているだけですが。
それでいいのでしょうか？

回答No.1

noname#104909

エクセルについて次々と質問するのであれば
専門のマイクロソフトの「答えてネット」でほぼ解決できると思います。
http://www.kotaete-net.net/Default.aspx