如果單元格包含大於零的值，則將單元格從一張紙復制到另一張紙

Question

我對 VBA 編程很陌生，我正面臨着一個巨大的工作簿，其中： 工作表 1 包含大約 40k 行數據和 40 列數據。 工作表 2 包含大約 550 行數據和 15 列數據。 我對兩張工作表中的數據所做的是將它們制作為表格，然后在同一列的兩個表格中搜索“A 到 Z”。

然后我想要做的是將數據（僅值）從工作表 2，第 12(L) 列復制到工作表 1，第 9(I) 列，但它應該只復制它工作表 1，第 9(I) 列包含一個值。

我嘗試了一些不同的代碼，但它似乎不起作用，你們有什么建議嗎？

Answer 1

可以使用Dictionary Object將小列表中的行中的值匹配到大列表。 使用單元格值作為鍵，行號作為值，從小列表上的匹配列構建字典。 然后向下掃描大列表並使用 .exists(key) 方法來確定是否存在匹配值。 如果存在字典鍵，則字典值為您提供小列表的行號。

此子將 sheet1 上的行與 sheet2 上具有相同列 A 值的行進行匹配。 對於匹配的行，如果兩列都有一個值，則工作表 1 上的列 I 值將替換為工作表 2 中的列 L 值。

Sub MyCopy()

  Const SOURCE As String = "Sheet2"
  Const TARGET As String = "Sheet1"
  Const COL_MATCH = "A"
  Const COL_SOURCE = "L"
  Const COL_TARGET = "I"

  Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
  Set wb = ThisWorkbook
  Set wsTarget = wb.Sheets(TARGET)
  Set wsSource = wb.Sheets(SOURCE)

  Dim iLastTargetRow As Long, iLastSourceRow As Long, iRow As Long
  iLastSourceRow = wsSource.Range(COL_MATCH & Rows.Count).End(xlUp).Row
  iLastTargetRow = wsTarget.Range(COL_MATCH & Rows.Count).End(xlUp).Row

  ' build lookup to row number from source sheet match column
  Dim dict As Object, sKey As String, sValue As String
  Set dict = CreateObject("Scripting.Dictionary")

  With wsSource
  For iRow = 1 To iLastSourceRow
      If .Range(COL_SOURCE & iRow).Value <> "" Then
          sKey = CStr(.Range(COL_MATCH & iRow).Value)
          If dict.exists(sKey) Then
              Debug.Print "Duplicate", sKey, iRow, dict(sKey)
          Else
              dict.Add sKey, iRow
          End If
      End If
  Next
  End With

  ' scan target sheet
  Dim countMatch As Long, countUpdated As Long
  With wsTarget
  For iRow = 1 To iLastTargetRow
      If .Range(COL_TARGET & iRow).Value <> "" Then

          ' match with source file
          sKey = CStr(.Range(COL_MATCH & iRow).value)
          If dict.exists(sKey) Then
              .Range(COL_TARGET & iRow).Value = wsSource.Range(COL_SOURCE & dict(sKey)).Value
              countUpdated = countUpdated + 1
              'Debug.Print iRow, sKey, dict(sKey)
          End If
          countMatch = countMatch + 1
      End If
  Next
  End With

  ' result
  Dim msg As String
  msg = "Matched = " & countMatch & vbCrLf & _
        "Updated = " & countUpdated

  MsgBox msg, vbInformation, "Completed"

End Sub