找不到为什么VBA代码没有输入If语句

Question

我试图通过两个单独的工作表（“Participaciones Bond”和“Participaciones VAL”）中的帐户进行排序，并将两张表中的客户复制到工作表“resumen”和在一个但不是另一个中的客户放入另一个“resumen”列。

在这两张纸上复制这些客户的部分效果很好，但我无法弄清楚为什么第二个if语句不起作用。

'Patribond= i, patriVal= j 
i = 5 
j = 5 
Do While Worksheets("Participaciones Bond ").Cells(i, "A") <> "" 
    j = 5 
    Do While Worksheets("Participaciones VAL ").Cells(j, "A") <> "" 
     If Worksheets("Participaciones Bond ").Cells(i, 1).Value = Worksheets("Participaciones VAL ").Cells(j, 1).Value Then 
      Worksheets("Participaciones Bond ").Activate 
      Sheets("Participaciones Bond ").Select 
      Worksheets("Participaciones Bond ").Rows(i).Copy Sheets("Resumen").Range("A1048576").End(xlUp).Offset(1, 0) 
      Exit Do 
     End If 
     j = j + 1 

     'personas en patribond que no aparecen en patrival' 
     If Worksheets("Participaciones VAL ").Cells(j, 1) = "" Then 
      Worksheets("Resumen").Activate 
      'Cells(3, "H").Value = "We got into the second IF"' 
      Worksheets("Participaciones Bond ").Activate 
      Range(Cells(i, "A"), Cells(i, "E")).Copy 
      Worksheets("Resumen").Activate 
      Range(Cells(i, "G"), Cells(i, "X")).Select 
      Worksheets("Resumen").Paste 
     End If 
    Loop 
    i = i + 1 
Loop 

Answer 1

我不知道你有哪些数据用于测试，但我认为你的代码工作得很好，那就是：它同时输入了If条件。但是你选择了它是写入单元格（“H3”）当您复制整行与指令

with Worksheets("Participaciones Bond ").Rows(i).Copy Sheets("Resumen").Range("A1048576").End(xlUp).Offset(1, 0) 

这是probabily覆盖的方式是我会怎么做。

您不需要更改选择，也不需要激活工作表以便从/向他们进行复制。

此外，我会以同样的方式复制两个表单中的记录和仅记录在第一个表单中的记录，而不是复制整行，但将源限制为包含数据的范围。这样您不会意外覆盖工作表右侧的列。并且您的记录也会复制到“Resumen”表单的顶部。

为了做到这一点，我改变

Rows(i).Copy. 

到

Range("A" & i, "E" & i).Copy. 

我也加入到三张纸引用尽管它是没有必要的。

Dim wBond   As Worksheet 
Dim wVal   As Worksheet 
Dim wRes   As Worksheet 

Set wBond = Worksheets("Participaciones Bond ") 
Set wVal = Worksheets("Participaciones Val ") 
Set wRes = Worksheets("Resumen") 

i = 5 
Do While Not IsEmpty(wBond.Cells(i, "A")) 
    j = 5 
    Do While Not IsEmpty(wVal.Cells(j, "A")) 

     If wBond.Cells(i, 1).Value = wVal.Cells(j, 1).Value Then 
      ' La persona está en ambas hojas: copiar en la columna correspondiente 
      wBond.Range("A" & i, "E" & i).Copy wRes.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
      Exit Do 
     End If 

     j = j + 1 

     If IsEmpty(wVal.Cells(j, 1)) Then 
      wBond.Range("A" & i, "E" & i).Copy wRes.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) 
     End If 

    Loop 
    i = i + 1 
Loop 

Answer 2

我在晚餐前就开始写这段代码并卡住了。现在我得到了充分的食物，但是线程可能已经超出了我所做的。基本上，我按照你的描述去写自己的代码。这是一种与你所采用的方法不同的方法，但随后我陷入了第二个IF的含义，并且无法弄清楚。请在我的数据上运行我的代码，并告诉我它是否值得继续。

该代码遍历Bond表上的所有名称，并将数据复制到Resumen表单中。如果在Val表中找到一个副本，它将Val数据的10列（我想知道这是否是一个逻辑错误）复制到列A，否则它复制Bond表中的10列数据（我认为它们是相同的，因此我宁愿将所有的债券都复制到K栏）。代码比你的简单，因此更易于调整。看一看。测试你的数据，看看你得到什么。

Sub CopyCustomers() 
    ' 06 Apr 2017 

    Dim WsBond As Worksheet 
    Dim WsVal As Worksheet 
    Dim WsRes As Worksheet 
    Dim Rl As Long       ' WsBond last row 
    Dim R As Long       ' WsBond row 
    Dim Rv As Long       ' found row in WsVal 
    Dim Rr As Long       ' next row in WsRes 
    Dim Cr As Long       ' column in WsRes 
    Dim Cust As String      ' customer name from WsBond 
    Dim Rng As Range      ' range to be copied to WsRes 

    Set WsBond = Sheets("Participaciones Bond ") 
    Set WsVal = Sheets("Participaciones VAL ") 
    Set WsRes = Sheets("Resumen") 

    Rr = 5 
    Application.EnableEvents = False 
    With WsBond 
     Rl = .Cells(.Rows.Count, 1).End(xlUp).Row 
     For R = 5 To Rl 
      Cust = .Cells(R, 1).Value 
      Rv = 0 
      On Error Resume Next 
      Rv = WorksheetFunction.Match(Cust, WsVal.Columns(1), 0) 
      ' no need to copy the entire row of 140K cells (takes too much time) 
      ' in each of the following rows 10 stands for 10 columns being copied 
      If Err = 0 Then 
       Set Rng = WsVal.Range(WsVal.Cells(Rv, 1), WsVal.Cells(Rv, 10)) 
       Cr = 1      ' paste to column A 
      Else 
       Set Rng = .Range(.Cells(R, 1), .Cells(R, 10)) 
       Cr = 11      ' paste to column K 
      End If 
      Rng.Copy Destination:=WsRes.Cells(Rr, Cr).Resize(1, 10) 
      Rr = Rr + 1 
      Err.Clear 
     Next R 
    End With 
    Application.EnableEvents = True 
End Sub 

Val表中可能有名称不在Bond表中。他们将很容易添加，但这将采取另一个循环，而不是另一个IF。您也可能不喜欢Resumen表单中的行的排列。易于调整。我想你可以自己做。你不需要10列，你不想要A列，你不赞同K列 - 所有的调整都很容易。如果您需要帮助，我会很乐意提供帮助。

Answer 3

假设你的数据有头第4行，你可以利用Autofilter()去像如下

Option Explicit 

Sub main() 
    Dim commonRng As Range, uniqueBondRng As Range, uniqueValRng As Range 

    GetCommonAndUniqueData "Participaciones Bond", "Participaciones VAL", commonRng, uniqueBondRng 
    GetCommonAndUniqueData "Participaciones VAL", "Participaciones Bond", commonRng, uniqueValRng 

    If Not commonRng Is Nothing Then commonRng.Copy Worksheets("Resumen").Range("a1") 
    If Not uniqueBondRng Is Nothing Then uniqueBondRng.Copy Worksheets("Resumen").Range("B1") 
    If Not uniqueValRng Is Nothing Then uniqueValRng.Copy Worksheets("Resumen").Range("C1")   
End Sub 

Sub GetCommonAndUniqueData(sht1Name As String, sht2Name As String, commonRng As Range, uniqueRng As Range) 
    Dim cell As Range 

    With Worksheets(sht1Name) 
     With .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)) 
      .AutoFilter Field:=1, Criteria1:=GetValues(sht2Name), Operator:=xlFilterValues 
      With .Offset(1).Resize(.Rows.Count - 1) 
       If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then Set commonRng = .SpecialCells(xlCellTypeVisible) 
       .Parent.AutoFilterMode = False 
       If commonRng Is Nothing Then 
        Set uniqueRng = .Cells 
       Else 
        Set uniqueRng = .Cells(.Rows.Count + 1, 1).Resize(1) 
        For Each cell In .Cells 
         If Intersect(commonRng, cell) Is Nothing Then Set uniqueRng = Union(uniqueRng, cell) 
        Next 
        Set uniqueRng = Intersect(uniqueRng, .Cells) 
       End If 
      End With 
     End With 
    End With 
End Sub 


Function GetValues(shtName As String) As Variant 
    With Worksheets(shtName) 
     GetValues = Application.Transpose(.Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Value) 
    End With 
End Function