Excel VBA复制粘贴值与条件

Question

如果 2 个字段相同（将这两个字段视为标识每条记录的键），我正在尝试将值从一张小表“带 ID 的 MD”复制到更大的表“带 ID 的 D”。

这是我的第一次尝试：

Sub CopyIDCells()

Set i = Sheets("MD with ID")
Set e = Sheets("D with ID")
Dim d
Dim j
d = 1
j = 2

Do Until IsEmpty(e.Range("B" & j))
    d = 2
    Do Until IsEmpty(i.Range("A" & d))
        If e.Range("C" & j).Value = i.Range("D" & d).Value Then
            If e.Range("M" & j).Value = i.Range("J" & d).Value Then
                e.Range("A" & j).Value = i.Range("B" & d).Value
            End If
        End If
        d = d + 1
    Loop
    j = j + 1
Loop

End Sub

这是我的第二次尝试：

Sub CopyIDCells2()

Set i = Sheets("MD with ID")
Set e = Sheets("D with ID")
Dim d
Dim j
d = 1
j = 2

Do Until j = 20886
    d = 2
    Do Until d = 1742
        If e.Cells(j, 3).Value = i.Cells(d, 4).Value Then
            If e.Cells(j, 13).Value = i.Cells(d, 10).Value Then
                e.Cells(j, 1).Value = i.Cells(d, 2).Value
            End If
        End If
        d = d + 1
    Loop
    j = j + 1
Loop

End Sub

此代码运行时，excel 工作表中没有任何变化，尽管运行需要几分钟 -_-"。

.. 样本被移除

Answer 1

因此，查看您的第一个 CopyIdCells 方法，我只会对此进行一个修复 - 使变量 d=2。这在您的示例数据顶部有标题，您需要像其他工作表一样从第 2 行开始。

Sub CopyIDCells()

Set i = Sheets("MD with ID")
Set e = Sheets("D with ID")
Dim d
Dim j
d = 2
j = 2

Do Until IsEmpty(e.Range("B" & j))
    d = 2
    Do Until IsEmpty(i.Range("A" & d))
        If e.Range("C" & j).Value = i.Range("D" & d).Value Then
            If e.Range("M" & j).Value = i.Range("J" & d).Value Then
                e.Range("A" & j).Value = i.Range("B" & d).Value
            End If
        End If
        d = d + 1
    Loop
    j = j + 1
    Loop

End Sub

除了您的公式看起来不错之外，您只是没有任何数据可以满足您的要求。将此列添加到“MD with ID”的底部，您将看到您的代码匹配。

mouse   10  08  11267   A/J M   823 1/11/2008   1   SC-807  LONG    10/10/2005

由于您在“案例编号”和“其他 ID”上进行匹配，因此两张表中都没有符合此条件的项目。当您将上面的行添加到“带有 ID 的 MD”时，您会在第二张表的几行中看到相应的 ID。