如果单元格包含大于零的值，则将单元格从一张纸复制到另一张纸答案

【问题标题】：Copy cells from one sheet to another if cell contains a value greater than zero如果单元格包含大于零的值，则将单元格从一张纸复制到另一张纸
【发布时间】：2020-02-08 09:31:59
【问题描述】：

我对 VBA 编程很陌生，我面临着一本巨大的工作簿，其中：表 1 包含大约 40k 行数据和 40 列数据。表 2 包含大约 550 行数据和 15 列数据。我对两张表中的数据所做的是将它们制作成一个表格，然后我在同一列的两个表格中搜索了“A 到 Z”。

然后我想要做的是将数据（仅值）从工作表 2 第 12 列（L）复制到工作表 1 第 9 列（I），但它应该只复制工作表 1，第 9（I）列包含价值。

我尝试了一些不同的代码，但似乎不起作用，你们有什么建议吗？

【问题讨论】：

两张纸上的哪一列相同，单元格、数字、日期或字符串中的内容是什么？请举几个例子。
Sheet1 中的何处从 Sheet1 的 L:L 列复制数据？你只说是列 I:I。在保留值的最后一行之后复制值？是不是需要找到两个范围之间的匹配并将值粘贴到Sheet1的等效键中？你能更好地解释这部分问题吗？从这个角度来看，一些展示相关内容的图片（至少可编辑会更好）也可以，但不是强制性的，如果你的解释足够好的话。除此之外，您是否有一段您自己尝试过的代码需要在这里改进？
抱歉，我没有提供任何图片，但您可以在此处查看工作表 1 和工作表 2 工作表 1：imgur.com/a/FeKTpMH 工作表 2：imgur.com/a/JEdCTXu 我尝试过的代码，将值发布在这不是我需要的空白单元格..
如果 sheet2 值为空白，您是否希望它删除工作表 1 上的值？
Sub Copy() Dim c As Range Dim j As Integer Dim Source As Worksheet Dim Target As Worksheet ' 更改工作表名称 Set Source = ActiveWorkbook.Worksheets("Sheet2") Set Target = ActiveWorkbook .Worksheets("Sheet1") J = 1 ' 开始复制到目标工作表中的第 1 行 For Each c In Source.Range("L2:L1000") ' Do 1000 rows If c > 0 Then Source.Rows(c.Row) .Copy Target.Rows(j) j = j + 1 End If Next c End Sub

标签： excel vba algorithm syntax conditional-statements

【解决方案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

【讨论】：