Excel VBA：如何比較值是否出現在兩列中並將其相鄰單元格值複製到另一列中？

Question

我試圖尋找2數據（從七月和八月）的設置和比較，得到的結果

1. 國家出現在七月和八月
2. 國家出現在七月，而不是在八月
3. 計算增減百分比對國家的計數值（出現在七月和八月）

下面是Excel的截圖，我指的

1. 取單元格A2的值 '美' 和列E搜索
2. 如果找到，複製單元格A1，B1和C1至柱H1，I1 &值J1

問題

1. 現在我想將列F中的值複製到列K（如果相同的國家出現在8月和7月）。
2. 例如，對於Cananda搜索，我的代碼邏輯可以複製同一行中的值，但不能在單元格F2（cos不同行）中複製值？任何想法分享如何做到這一點？

下面是我的VBA代碼

Sub Compare() 
Dim Report As Worksheet, lastRow As Long, fVal As Range, c As Range, i As Long 
Set Report = Sheets(1) 'Edit sheet name 
lastRow = Report.Cells(Rows.Count, 1).End(xlUp).Row 
    'For Each c In Report.Range("A2:A10") 'Assumes header row 
    For i = 2 To lastRow 
     'Set fVal = Report.Range("E2:E" & lastRow).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) 
     Set fVal = Report.Range("E2:E" & lastRow).Find(Report.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole) 
      If Not fVal Is Nothing Then 
       'c.Interior.ColorIndex = 6 
       Report.Cells(i, 1).Interior.ColorIndex = 6 
       Report.Cells(i, 8) = Report.Cells(i, 1) 
       Report.Cells(i, 9) = Report.Cells(i, 2) 
       Report.Cells(i, 10) = Report.Cells(i, 3) 
      Else 
       Report.Cells(i, 13) = Report.Cells(i, 1) 
       Report.Cells(i, 14) = Report.Cells(i, 2) 
      End If 
    Next 
End Sub 

Answer 1

我想這你想要做什麼。使用Resize縮短了代碼。你需要引用你找到的單元格（在這種情況下，我理解它的右邊是一個單元格）。

Sub Compare() 

Dim Report As Worksheet, lastRow As Long, fVal As Range, c As Range, i As Long 

Set Report = Sheets(1) 'Edit sheet name 
lastRow = Report.Cells(Rows.Count, 1).End(xlUp).Row 
    For i = 2 To lastRow 
     Set fVal = Report.Range("E2:E" & lastRow).Find(Report.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole) 
     If Not fVal Is Nothing Then 
      Report.Cells(i, 1).Interior.ColorIndex = 6 
      Report.Cells(i, 8).Resize(, 3).Value = Report.Cells(i, 1).Resize(, 3).Value 
      Report.Cells(i, 11).Value = fVal.Offset(, 1).Value 
     Else 
      Report.Cells(i, 13).Resize(, 2).Value = Report.Cells(i, 1).Resize(, 2).Value 
     End If 
    Next i 

End Sub