[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セルの値と同じシート名に転記』（だいき）
どなたかご教示ください。
"一覧"シートのA〜Iの２行目以降にデータを入れていくものがあり、A列に1〜12月が入力されます。
1〜12月のシートを作成しており、一致する月に自動でA〜Iのデータを転記させたいのですが、どのような構文で可能でしょうか？
A２が４月なら、４月のシートのA2〜I2にA2〜I2を転記、A4も4月なら4月シートのA3〜I3に転記みたいにしたいです。
お願い致します。
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
>A２が４月なら、４月のシートのA2〜I2にA2〜I2を転記、
>A4も4月なら4月シートのA3〜I3に転記みたいにしたいです
「一覧」シート 「4月」シート
A2 4月 「一覧」シートのA2〜I2 → 行一致 A4 4月 「一覧」シートのA3〜I3 → 行不一致
関連性の説明がいるかもね。 （GobGob） 2020/06/24(水) 13:14
（γ） 2020/06/25(木) 08:33
Dim c As Range
For Each c In Sheets("一覧").Range("A:A").SpecialCells(2)
c.Resize(, 11).Copy Sheets(c.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
Next c
End Sub
（mm） 2020/06/25(木) 09:17
Excel365がないのでFilter関数を使わない例です。
[一覧]シート [A] [B] [C] [D] [1] 月 項目1 項目2 項目3 [2] 4月 10 11 12 [3] 5月 20 21 22 [4] 4月 30 31 32 [5] 3月 40 41 42 [6] 4月 50 51 52
[4月]シート [A] [B] [C] [1] 項目1 項目2 項目3 [2] 10 11 12 [3] 30 31 32 [4] 50 51 52
4月シートのA2に
=IFERROR(INDEX(一覧!B$1:B$10,SMALL(IF(一覧!$A$1:$A$10="4月",ROW($A$1:$A$10)),ROW(A1))),"")
と入力して、CtrlとShiftキーを押しながらEnterで確定、配列数式にします。 A2を右、下にコピーするとこうなりす。
数式中、"4月"の部分は例えばA1セルに「4月」と入力しておきセル参照するのがお薦めですが 今回はあえてご指定通りのA2からデータを表示するためこのようにしてみました。
A2=IFERROR(INDEX(一覧!B$1:B$10,SMALL(IF(一覧!$A$1:$A$10=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,5),ROW($A$1:$A$10)),ROW(A1))),"")
として同様に配列数式にしても同じ結果が得られますが、 式が複雑になり個人的にはA1に「4月」と入力しておくやり方が好きです。
（tora） 2020/06/25(木) 09:20
Dim a, b, c, i As Long, j As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("一覧")
a = ws1.Cells(Rows.Count, "A").End(xlUp).Row
b = Worksheets.Count
For i = 2 To a
For j = 2 To b
If ws1.Cells(i, "A").Value = Worksheets(j).Name Then
c = Worksheets(j).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Worksheets(j).Cells(c, "A").Resize(1, 9).Value = ws1.Cells(i, "A").Resize(1, 9).Value
End If
Next j
Next i
でいけると思ったのですが作動しません。エラーは出ず何も反映されない状態です。どこがミスしているのでしょうか？
（だいき） 2020/06/29(月) 09:58
動作とは直接関係ありませんが、
Dim a, b, c, i As Long この書き方は a, b, c, は Long型ではなく、Variantになります。 すべてLong型で宣言する場合は、Dim a As LongDim , b As Long c, As Longのように個別に指定します。
それはともかくとして、このコード自体は問題なく作動します。 「エラーもでず何も反映されない」ということは、
一覧シートのA列の月と各月のシートの数字のどちらかが半角でどちらかが全角のようになっていると その月のシートと認識されずに何も反映されない状態になりますが、そこは大丈夫でしょうか?
または一覧シートの列は本当は日付(シリアル値)で、表示形式で月のみの表示にしているとか・・ （tora） 2020/06/29(月) 12:36
半角全角ですが、一覧のA列をどちらで入力してみても反映されません。
入力も"4月"なら"4月"のみしか入ってませんでした・・・・・
（だいき） 2020/06/29(月) 16:08
すみません、間違いました。一行に書く場合は、 Dim a As Long, b As Long, c As Long, i As Long, j As Long のようにします。
または、 Dim a As Long Dim b As Long ・・・ のように複数行に書きます。
なお、何も表示されないとのことですが、こちらでテストしてみましたが、正常に動きます。 コードは、最初にだいきさんが提示されたものをそのまま修正せずにテストしています。
実際にはどういうレイアウトで、月のシートはいくつ作ってテストしていますか。 提示されたコードは、左から2番目のシート以降に転記するようなコードですよね。 「4月」シートを一番左において実行すれば「4月」シートには何も転記されません。 その場合でも「5月}とかほかのシートには転記されるはずですけど・・・・
実際にテストしたレイアウトをここに提示できませんか。
（tora） 2020/06/29(月) 16:51
左から
一覧 ４月 ５月・・・・３月
の順番でシートがあります。
各シート一覧と同じ作りで1行目にも同じものが入力されている状況です。
（だいき） 2020/06/30(火) 08:55
こちらでテストしたデータです。
[一覧]シート [A] [B] [C] [D] [E] [F] [G] [1] 月 項目1 項目2 項目3 項目4 項目5 項目6 [2] 4月 4月(1)の1 4月(1)の2 4月(1)の3 4月(1)の4 4月(1)の5 4月(1)の6 [3] 5月 5月(1)の1 5月(1)の2 5月(1)の3 5月(1)の4 5月(1)の5 5月(1)の6 [4] 6月 6月(1)の1 6月(1)の2 6月(1)の3 6月(1)の4 6月(1)の5 6月(1)の6 [5] 7月 7月(1)の1 7月(1)の2 7月(1)の3 7月(1)の4 7月(1)の5 7月(1)の6 [6] 8月 8月(1)の1 8月(1)の2 8月(1)の3 8月(1)の4 8月(1)の5 8月(1)の6 [7] 4月 4月(2)の1 4月(1)の2 4月(2)の3 4月(1)の4 4月(2)の5 4月(1)の6 [8] 5月 5月(2)の1 5月(1)の2 5月(2)の3 5月(1)の4 5月(2)の5 5月(1)の6
[4月]シート [A] [B] [C] [D] [E] [F] [G] [1] 月 項目 項目2 項目3 項目4 項目5 項目6 [2]
のシートで提示されたコードを実行すると、4月シートは
[A] [B] [C] [D] [E] [F] [G] [1] 月 項目1 項目2 項目3 項目4 項目5 項目6 [2] 4月 4月(1)の1 4月(1)の2 4月(1)の3 4月(1)の4 4月(1)の5 4月(1)の6 [3] 4月 4月(2)の1 4月(1)の2 4月(2)の3 4月(1)の4 4月(2)の5 4月(1)の6
のようになりました。 実際には5月シートも作ってありましたが同様の結果なのでここでは省略しています。 6月以降のシートはテストなので作っていません。 コードは、全く変更していません。提示されたものをそのままコピーして貼り付けただけです。
新規シートに上のデータと同じものを作って試してみてください。 また、ステップインでコードを一行ずつ実行してみてください。
If ws1.Cells(i, "A").Value = Worksheets(j).Name Then c = Worksheets(j).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row Worksheets(j).Cells(c, "A").Resize(1, 9).Value = ws1.Cells(i, "A").Resize(1, 9).Value End If
この二行目と三行目を実行しているか確認してください。
（tora） 2020/06/30(火) 09:28
再度やり直してみましたが、やはりうまくいきません。
ステップインで試したところ、ご指摘の箇所が飛んでいました・・・
なにかミスをしているということでしょうか？
（だいき） 2020/06/30(火) 12:07
そこが飛んでいるということは、一覧シートの月(例えば4月)と、シート名(4月)が一致していないということです。 一覧シートの月とシート名をもう一度、手で入力しなおしてみてください。全部じゃなくていいです。 一覧シートの4月を2〜3か所と、4月のシート名だけでいいです。 それでもう一度試してみてください。
よくあるのは、シートに入力されている4月は後ろに見えないスペースがくっついていることがありますので再度ご確認ください。 、 （tora） 2020/06/30(火) 13:39
ですが、一覧シートには次々と入力されていくのですが、毎回毎回各シートに転記されてしまいます。
例えば6行目まで入力されていて、各シートに振り分けされた状態で、7行目以降に入力された後6行目も転記されてしまう状態です。
新しく入力された分のみ追加で転記したいのですが、
そこの解決策はありますでしょうか？
度々申し訳ございません。
（だいき） 2020/06/30(火) 13:53
一覧シートにに追加で入力された場合、あなたが目で見てどこからが追加の分かわかりますか? わからなければエクセルにもわかりません。
解決策として、一覧シートから転記済みのデータには「済」と入れるセルを使い、 VBAではそれ以降のデータだけを転記するようにすればいいです。 例えば一覧シートのJ1に「転記」とでも入力しておき、次のコードを実行してみてください。
Sub test2()
Dim a As Long, b As Long, c As Long, i As Long, j As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("一覧")
a = ws1.Cells(Rows.Count, "a").End(xlUp).Row
b = Worksheets.Count
For i = ws1.Cells(Rows.Count, "J").End(xlUp).Row + 1 To a '//この行を修正
For j = 2 To b
If ws1.Cells(i, "A").Value = Worksheets(j).Name Then
c = Worksheets(j).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Worksheets(j).Cells(c, "A").Resize(1, 9).Value = ws1.Cells(i, "A").Resize(1, 9).Value
ws1.Cells(i, "J").Value = "済" '//この行を追加
End If
Next j
Next i
End Sub
転記が終わるとJ列に「済」と表示され、そのデータは次回以降転記されません。 （tora） 2020/06/30(火) 15:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.