检查F列中的值并检查G列中是否存在值

Question

我正在使日常流程自动化。 我在F列中有ID，在G列中有ID2。如果F列中的ID相同，如何编写VBA来填充空白？ IE ID 123的ID始终为1。在某些情况下，要使用的ID不是上面的ID。

测试数据：

ID       ID2
123      1
123      *Blank*
456      56
456      *Blank*
456      *Blank*
789      23

我已经利用了一些现有的stackoverflow代码，并尝试使其适应我的需求。 代码：Sub FindingBID（）

 Dim sht As Worksheet, lastrow As Long, i As Long, j As Long

 Set sht = ThisWorkbook.Worksheets("Roots data")
 lastrow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row

  For i = 1 To lastrow
  If Range("G" & i).Value = "" Then
    For j = 1 To lastrow
        If Range("C" & i).Value = Range("F" & j).Value And Range("G" & 
     j).Value <> "" Then
            Range("H" & i).Value = Range("G" & j).Value
            Exit For
        End If
    Next j
 End If
 Next i
  End Sub

Answer 1

如下所示？ 我需要在其他计算机上进行快速语法检查。

Sub test()

Dim wb As Workbook
Set wb = ThisWorkbook

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Roots data")

lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row

Dim dataArr()

dataArr = ws.Range("F1:G" & lastRow).Value
Dim currentRow As Long
Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)

    If Not IsEmpty(dataArr(currentRow, 2)) And Not dict.exists(dataArr(currentRow, 1)) Then
        dict.Add dataArr(currentRow, 1), dataArr(currentRow, 2)
    End If

Next currentRow

For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)

    If IsEmpty(dataArr(currentRow, 2)) Then

        dataArr(currentRow, 2) = dict(dataArr(currentRow, 1))

    End If

Next currentRow

ws.Range("F1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr

End Sub