VBA比較コード

Question

私のVBAコードは、同じシートの2列を比較して、列AとBを比較し、結果を列Dと列Eに入れます。

列Aの「コミュニティR1」は列Bのものと異なる 列D iの「コミュニティR2」は列Aに存在するが、列Bおよび列Eには存在しないデータを有する列Bではなく、列Aではない。 それはちょうどフィンを働かせますが、1つの問題があります。私がコードを実行するときに、列AとBのデスパイパのヘッダーが実行されます。解決策を見つけるのを助けてくれますか？

これはコードである：

Sub two_cols() 

Dim d1 As Object, d2 As Object, d3 As Object, e 
Application.ScreenUpdating = False 
Range("D2:E30000").Clear 



Set d1 = CreateObject("scripting.dictionary") 
Set d2 = CreateObject("scripting.dictionary") 
Set d3 = CreateObject("scripting.dictionary") 
Cells(1) = Range("A2") 
Cells(2) = Range("B2") 
For Each e In Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row).Value 
    d1(e) = True 
    d2(e) = True 
Next e 

For Each e In Cells(2).Resize(Cells(Rows.Count, 2).End(3).Row).Value 
    If (d2(e)) * (d1.exists(e)) Then d1.Remove e 
    If Not d2(e) Then d3(e) = True 
Next e 

On Error Resume Next 
Range("D2").Resize(d1.Count) = Application.Transpose(d1.keys) 
Range("E2").Resize(d3.Count) = Application.Transpose(d3.keys) 
On Error GoTo 0 
Application.ScreenUpdating = True 
End Sub 

、これはファイルである：http://www.cjoint.com/c/FCFoqR7niZv

Answer 1

これは結果である： 細胞（1）=レンジ（ "A2"） 細胞（2） =範囲（ "B2"）

ヘッダー行を失うことはありませんがヘッダー行を比較している場合は、これをコメントアウトすると、ヘッダーセルの値がA2とB2 に設定されます。スクリプトの次のバージョンをお勧めします。

Sub two_cols() 

Dim d1 As Object, d2 As Object, d3 As Object, e 
Application.ScreenUpdating = False 
Range("D2:E30000").Clear 



Set d1 = CreateObject("scripting.dictionary") 
Set d2 = CreateObject("scripting.dictionary") 
Set d3 = CreateObject("scripting.dictionary") 
'Cells(1) = Range("A2") 
'Cells(2) = Range("B2") 
Dim header1 As Boolean 
Dim header2 As Boolean 
header1 = True 
header2 = True 

For Each e In Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row).Value 
    If header1 = False Then 
     d1(e) = True 
     d2(e) = True 
    Else 
     header1 = False 
     End If 
Next e 

For Each e In Cells(2).Resize(Cells(Rows.Count, 2).End(3).Row).Value 
    If header2 = False Then 
     If (d2(e)) * (d1.exists(e)) Then d1.Remove e 
     If Not d2(e) Then d3(e) = True 
    Else 
     header2 = False 
    End If 
Next e 

On Error Resume Next 
Range("D2").Resize(d1.Count) = Application.Transpose(d1.keys) 
Range("E2").Resize(d3.Count) = Application.Transpose(d3.keys) 
On Error GoTo 0 
Application.ScreenUpdating = True 
End Sub