找不到爲什麼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