マクロdictionaryオブジェクト書き換え
ここで教えていただいたマクロを
シート1のＦ列を検索値として
シート2のＡ列を検索しヒットしたら
シート2の該当行のＤ列をシート1のＡＥ列に転記。
データの２列目から行う。ヒットしない場合は 無 と転記。
と変更したくて記述を書き換えたらシート1が壊れてしまいました。
正しい記述を教えてください。
↓教えていただいた書き換え前の正常動作する記述↓
Sub 検索()
'dictionaryオブジェクトを使用
'シート1のＡ列を検索値として
'シート2のＡ列を検索しヒットしたら
'シート2の該当行のＥ列をシート1のＣ列に転記
'データの２行目から行う。ヒットしない場合は無しと転記
Dim dic As Object
Dim i As Long
Dim v, w
Dim t As Single
t = Timer
With Sheets("Sheet2")
'返す値を指定E列
With .Range("E2", .Cells(.Rows.Count, 1).End(xlUp))
'検索する列指定 (1)=A列
v = .Columns(1).Value
'返す値のある列指定 (5)=E列
w = .Columns(5).Value
End With
End With
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic(v(i, 1)) = i
Next
With Sheets("Sheet1")
'検索値のある列指定 A列
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
v = .Value
For i = 1 To UBound(v)
If dic.exists(v(i, 1)) Then
v(i, 1) = w(dic(v(i, 1)), 1)
Else
v(i, 1) = "無"
End If
Next
'転記する列を指定 Offset(, 2)=検索値のA列より右2つ→C列
With .Offset(, 2)
.ClearContents
.Value = v
End With
End With
End With
Set dic = Nothing
Debug.Print Timer - t
End Sub
----
↓書き換えておかしな動きになった物 ●の部分を変更しました↓
Sub 検索02()
'dictionaryオブジェクトを使用
'シート1のＦ列を検索値として
'シート2のＡ列を検索しヒットしたら
'シート2の該当行のＤ列をシート1のAE列に転記
'データの２行目から行う。ヒットしない場合は無しと転記
Dim dic As Object
Dim i As Long
Dim v, w
Dim t As Single
t = Timer
With Sheets("Sheet2")
'返す値を指定D列●
With .Range("D2", .Cells(.Rows.Count, 1).End(xlUp))
'検索する列指定 (1)=A列
v = .Columns(1).Value
'返す値のある列指定 (4)=D列●
w = .Columns(4).Value
End With
End With
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic(v(i, 1)) = i
Next
With Sheets("Sheet1")
'検索値のある列指定 F列●
With .Range("F2", .Cells(.Rows.Count, 1).End(xlUp))
v = .Value
For i = 1 To UBound(v)
If dic.exists(v(i, 1)) Then
v(i, 1) = w(dic(v(i, 1)), 1)
Else
v(i, 1) = "無"
End If
Next
'転記する列を指定
'Offset(, 25)=検索値のA列より右25個→AE列●
With .Offset(, 25)
.ClearContents
.Value = v
End With
End With
End With
Set dic = Nothing
Debug.Print Timer - t
End Sub
お礼
ありがとうございました。初めは幅が狭くなってどうすれば良いのかよく分からなかったのですが、何とか出来ました。後で幅を設定すればよいのですね。