VBA测试两个值,如果一个不同,则复制

时间:2017-08-14 14:36:34

标签: excel vba excel-vba

我在使用以下代码时遇到了相当多的麻烦:

Sub TestEmail()

    Dim i As Long
    Dim LastRow As Long
    Dim a As Worksheet
    Dim b As Worksheet
    Dim strText
    Dim ObjData As New MSForms.DataObject
    Set a = Workbooks("Book2").Worksheets(1)
    Set b = Workbooks("Book1").Worksheets(1)
    LastRow = a.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To LastRow
        If Not IsError(Application.Match(a.Cells(i, 7).Value, b.Columns(3), 0)) And IsError(Application.Match(a.Cells(i, 4).Value, b.Columns(11), 0)) Then
            a.Range("D" & i).Copy
            ObjData.GetFromClipboard
            strText = Replace(ObjData.GetText(), Chr(10), "")
            b.Range("K" & ).Value = b.Range("K" & ).Value & " / " & strText
        End If
    Next i

End Sub

我面临两个问题,一个是我难倒,另一个是缺乏知识:

IF之后的行应该检查两个工作簿中的两个值(数字)是否匹配,以及其他两个值(文本)是否匹配。如果全部为true,则它必须从Book2复制一个值并将其添加到book1中的单元格。

问题是:

- 宏似乎无法识别值是否匹配。

- 在&#34;结束之前的最后一行&#34;,我不知道如何告诉excel将文本复制到第二次检查中不匹配的单元格中。< / p>

如果我不够清楚,我很抱歉,这很难解释。

我希望其中一位专家知道如何开展这项工作。

提前致谢

1 个答案:

答案 0 :(得分:0)

  • 您正在使用If Not condition 1 And condition 2,因此您说如果它不符合这两个条件,那么您运行代码。您要做的是Nested If Statements但是,一个是If而另一个是If Not
  • 要复制,您错过了i&#34; K&#34;&amp;:b.Range("K" & i) = b.Range("K" & i).Value & " / " & strText
  • 单元格的地址位于范围函数内,在您的情况下将是:

//It is the cell of the email from the first Workbook tou are copying, where you input the column D

a.Range("D" & i).Copy

//Add to Workbook b in column K the value from Cell K#/value copied

b.Range("K" & i) = b.Range("K" & i).Value & " / " & strText

你也可以这样:b.Range("K" & i) = b.Range("K" & i).Value & " / " & a.Range("D" & i)

这种方式是匹配行,因此只有当两个工作簿上的ID位于同一行时才能使用。如果他们不是,则必须使用Nesting Loops.Find Function

修改

  • 如果我理解了,如果您对应用程序进行了一些更改,下面的代码可能会有效,因为我没有要测试的数据和列等。尝试实现它。

LastRowa = a.Cells(Rows.Count, "A").End(xlUp).Row
LastRowb = b.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRowa
    'Address of String to look for 
    LookForString = a.Worksheets(1).Cells(i, 4) '4 is the COLUMN_INDEX
    'Range to look on Workbook a
    With a.Worksheets(1).Range("D1:D" & LastRowa) 'choose column to look
        'Function .Find String on book a
     Set mail_a = .Find(LookForString, LookIn:=xlValues)
        If Not mail_a Is Nothing Then
        FirstAddress = mail_a.Address
            Do ' Actions here
               'Range to look on Workbook b
               With b.Worksheets(1).Range("K1:K" & LastRowb) 'choose column to look
                    'Function .Find on Workbook b
                   Set mail_b = .Find(LookForString, LookIn:=xlValues)
                     If Not mail_b Is Nothing Then
                     FirstAddress = mail_b.Address
                         Do 'Actions
                         'Verify if two other values (text) don't match
                         If Not WRITE_MATCH_CONDITION_HERE Then
                            'No need to verify of they are equal because the .Find function used the same reference
                            'I will use .Cells with .Row and .Column just to show another way to do it and make it dynamic
                            b.Cells(mail_b.Adress.Row, mail_b.Adress.Column) = b.Cells(mail_b.Adress.Row, mail_b.Adress.Column).Value & " / " & a.Cells(mail_a.Adress.Row, mail_a.Adress.Column) 'choose columns
                         End If
                     Set mail_b = .FindNext(mail_b)
                         Loop While Not mail_b Is Nothing And mail_b.Address <> FirstAddress
                     End If
               End With
                Set mail_a = .FindNext(mail_a)
            Loop While Not mail_a Is Nothing And mail_a.Address <> FirstAddress
        End If
    End With  
    Next i 
    End Sub

LastRowa = a.Cells(Rows.Count, "A").End(xlUp).Row LastRowb = b.Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To LastRowa 'Address of String to look for LookForString = a.Worksheets(1).Cells(i, 4) '4 is the COLUMN_INDEX 'Range to look on Workbook a With a.Worksheets(1).Range("D1:D" & LastRowa) 'choose column to look 'Function .Find String on book a Set mail_a = .Find(LookForString, LookIn:=xlValues) If Not mail_a Is Nothing Then FirstAddress = mail_a.Address Do ' Actions here 'Range to look on Workbook b With b.Worksheets(1).Range("K1:K" & LastRowb) 'choose column to look 'Function .Find on Workbook b Set mail_b = .Find(LookForString, LookIn:=xlValues) If Not mail_b Is Nothing Then FirstAddress = mail_b.Address Do 'Actions 'Verify if two other values (text) don't match If Not WRITE_MATCH_CONDITION_HERE Then 'No need to verify of they are equal because the .Find function used the same reference 'I will use .Cells with .Row and .Column just to show another way to do it and make it dynamic b.Cells(mail_b.Adress.Row, mail_b.Adress.Column) = b.Cells(mail_b.Adress.Row, mail_b.Adress.Column).Value & " / " & a.Cells(mail_a.Adress.Row, mail_a.Adress.Column) 'choose columns End If Set mail_b = .FindNext(mail_b) Loop While Not mail_b Is Nothing And mail_b.Address <> FirstAddress End If End With Set mail_a = .FindNext(mail_a) Loop While Not mail_a Is Nothing And mail_a.Address <> FirstAddress End If End With Next i End Sub p.s。:&lt;&gt; mail_a.Address&lt;&gt;上缺少FirstAddress和mail_b.Address&lt;&gt; FirstAddress,当我发布