マクロ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
お礼
確認しました！素晴らしいでーす！！！思った通りに出来ました、スッキリしました。 しかもこんなにお早くありがとうございました。 早速色々と仕上げに掛かろうと思います。大変感謝致しますm(_ _)m またよろしくお願い致します