Excel VBA質問箱 IV

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

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


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

16020 / 76734

←次へ　｜　前へ→


	【66188】Re:列検索の列の変数対応について

kanabun - 10/8/6(金) 20:16 -


	引用なし

	パスワード

▼カンジさん：

>＞実行したいことは
>
>Sheet1のCells(i,1)の値を
>　 Sheet2の　　　　　　　　　　　　　 Sheet1の
>　【1列目から探し】 Offset(,1)の値を　 .Cells(i,5)にもってくる
>　【3列目から探し】 Offset(,1)の値を　 .Cells(i,8)にもってくる
>　【5列目から探し】 Offset(,1)の値を　 .Cells(i,11)にもってくる
>　【7列目から探し】 Offset(,1)の値を　 .Cells(i,14)にもってくる
>　【9列目から探し】 Offset(,1)の値を　 .Cells(i,17)にもってくる
>　【11列目から探し】 Offset(,1)の値を　 .Cells(i,20)にもってくる
>　【13列目から探し】 Offset(,1)の値を　 .Cells(i,23)にもってくる
>　【15列目から探し】 Offset(,1)の値を　 .Cells(i,26)にもってくる
>　【17列目から探し】 Offset(,1)の値を　 .Cells(i,29)にもってくる
>　【19列目から探し】 Offset(,1)の値を　 .Cells(i,32)にもってくる
>　【21列目から探し】 Offset(,1)の値を　 .Cells(i,35)にもってくる
>　【23列目から探し】 Offset(,1)の値を　 .Cells(i,38)にもってくる
>
>（以上を繰り返す）
で合ってるなら、

次のようにすればできると思います
　(内側のLoop jを Sheet2の【検索列番号】に変えてあります。なので Step 2 )

Sub 列検索でデータを取り込む3()
　　Dim i As Long
　　Dim j As Long
　　Dim h As Long
　　Dim S As String
　　Dim c As Range, r2 As Range
　　Dim WS1 As Worksheet
　　Dim WS2 As Worksheet
　　
　　Set WS1 = Worksheets("sheet1")
　　Set WS2 = Worksheets("sheet2")
　　Set r2 = WS2.UsedRange
　　With WS1
　　　　For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　S = .Cells(i, 1).Value
　　　　　　h = 5
　　　　　　For j = 1 To 23 Step 2 '← j は Sheet2の検索列番号
　　　　　　　　Set c = r2.Columns(j).Find(S, , xlValues, xlWhole)
　　　　　　　　If Not c Is Nothing Then　　　'見つかったら
　　　　　　　　　　　　　　　　　　　　　　　'Sheet1のｈ列に値コピー
　　　　　　　　　　.Cells(i, h).Value = c.Offset(, 1).Value
　　　　　　　　End If
　　　　　　　　h = h + 3 '次のコピー列
　　　　　　Next j
　　　　Next
　　End With
End Sub

また、h は j の関数なので以下のようにも書けると思います。

Sub 列検索でデータを取り込む4()
　　Dim i As Long
　　Dim j As Long, h As Long
　　Dim S As String
　　Dim c As Range, r2 As Range
　　Dim WS1 As Worksheet
　　Dim WS2 As Worksheet
　　
　　Set WS1 = Worksheets("sheet1")
　　Set WS2 = Worksheets("sheet2")
　　Set r2 = WS2.UsedRange
　　With WS1
　　　　For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　S = .Cells(i, 1).Value
　　　　　　For j = 1 To 23 Step 2 '← j は Sheet2の検索列番号計12列検索
　　　　　　　　Set c = r2.Columns(j).Find(S, , xlValues, xlWhole)
　　　　　　　　If Not c Is Nothing Then 'Sheet1のｈ列に値コピー
　　　　　　　　　　h = 3.5 + j * 3 / 2　　　'◆転記先列番号の計算
　　　　　　　　　　.Cells(i, h).Value = c.Offset(, 1).Value
　　　　　　　　End If
　　　　　　Next j
　　　　Next
　　End With
End Sub

4 hits

▼

【66148】列検索の列の変数対応について カンジ 10/8/5(木) 16:38