Excel VBA复制粘贴条件值

Question

我试图从一个小的工作表“带ID的MD”的值复制到一个较大的工作表“带ID的D”如果2个字段是相同的（考虑这两个作为标识每个记录的键）。

这是我第一次尝试：

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 

这里是我的第二次尝试：在Excel工作表此代码运行时

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 

没有什么变化，但它需要几分钟的时间来运行-_ - ”

..取出样品

Answer 1

所以看你的第一CopyIdCells方法，我只会对此做一个修正 - 使变量d = 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 

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

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

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