|
▼カンジ さん:
>> 実行したいことは
>
>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の h列に値コピー
.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列に値コピー
h = 3.5 + j * 3 / 2 '◆転記先列番号の計算
.Cells(i, h).Value = c.Offset(, 1).Value
End If
Next j
Next
End With
End Sub
|
|