Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4773 / 76732

←次へ　｜　前へ→


	【77575】マッチしたら指定範囲を別シートへコピー

soul-taker - 15/10/26(月) 16:25 -


	引用なし

	パスワード

初めて投稿致します。
よろしくお願いします。

・sheetＡ
　「A5：I20」に文字データが入っています。
　（途中に空白列有り。最終行は月度によって変動。）

・sheetＢ
　「A5：A30」に文字データが入っています。
　（途中に空白列有り。最終行は月度によって変動。）

・sheetＡの「A5」列と同じ値のものがsheetＢの「A5」列内に
　あった場合、その同じ値の行の「C列からI列」をsheetＡ→
　sheetＢにコピーする。
　（sheetＡもsheetＢも都度、最終行が変わるので、文字デー
　　タの範囲が変わる。）
・できれば、途中で並べ替えの作業等や作業列の作成はしたく
　ない。

　<例>
　　【sheetＡ】
　　　　　　　Ａ　　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ
　　　　5　　0001　　　　○　あ　　　　　○　か
　　　　6　　0006　　　　○　い
　　　　7
　　　　8　　0035　　　　　　　　○　○　○　き
　　　　9　　0018　　　　○　う　　　　　　　　　○
　　　　・
　　　　・
　　　 19　　0099　　　　　　　　○　　　○
　　　 20　　0102　　　　○　え
　

　　【sheetＢ】
　　　　sheetＢは、最初はＡ列のみにデータがあり、Ｃ～
　　　　Ｉ列は空白の状態。
　　　　5行目、6行目、9行目が、それぞれsheetＡの5行目
　　　　6行目、8行目と同じなので、それぞれのsheetＡの
　　　　Ａ列でマッチしたＣ列～Ｉ列をsheetＢのＣ列～Ｉ
　　　　列にコピーして、下記の結果としたい。

　　　　　　　Ａ　　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ
　　　　5　　0001　　　　○　あ　　　　　○　か
　　　　6　　0006　　　　○　い
　　　　7　　0042
　　　　8
　　　　9　　0035　　　　　　　　○　○　○　き
　　　 10　　0051
　　　・
　　　・
　　　 30　　0099　　　　　　　　○　　　○

これを下記のように記述したところ、うまくいかずに悩んでい
ます。

Dim r1 As Range, r2 As Range, c As Range
Dim m As Variant

Sheets(Ａ).Select

With Worksheets(Ａ)
　　Set r2 = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp))
End With
With Worksheets(Ｂ)
　　Set r1 = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp))
End With
　
For Each c In r1
　　m = Application.Match(c.Value2, r2, 0)
　　If IsNumeric(m) Then
　　　　r2.Item(m, 3).Resize(, 7).Copy c.Item(1, 3)
　　End If
Next

別のところで、うまくいっていた事例を移植したのですが、
（実のところ、中身がきちんと理解できていないので）どこ
がマズイのかが見つけられませんでした。

どなたか、ご助言いただけますと助かります。
何とぞ、よろしくお願い致します。

0 hits

▼

【77575】マッチしたら指定範囲を別シートへコピー soul-taker 15/10/26(月) 16:25