循环和如果不工作的第二条指令

Question

我在Excel VBA相对较新，我正在做的是我们的一个ERP的加载器。所以我的问题是这样的......我有一个excel工作表，我们称之为原点和另一个，让我们称之为假。

我想要做的是宏检查是否某个单元格（af18）在原始范围落入标准。如果它是真的，那么将A18从原始工作表复制到虚拟工作表。然后在下一列插入“{tab}”，然后如果AF19（下一个单元格）落入标准中，则将a19复制到虚拟的下一个空白列，然后再插入{tab}

当前代码生成：1,2,3...\{tab}

但我希望它是这样的：1,\{tab},2,\{tab}...

Sub CreateLoaderBeta() 

    Dim origin As Worksheet 
    Dim destination As Worksheet 
    Dim desrow As Long 
    Dim descol As Long 
    Dim descolstart As Long 
    Dim origrow As Long 
    Dim origcol As Long 
    Dim rang As Range 
    Dim C As Range 
    Dim qual As Integer 

    Set origin = Sheets("1") 
    Set destination = Sheets("dummy") 
    desrow = 3 
    descol = 1 
    origrow = 18 
    origcol = 32 
    Set rng = Sheets("1").Range("AF18:af47") 
    total = WorksheetFunction.SUM(Worksheets("1").Range("AF18:AF47")) 
    descolstart = destination.cells(desrow, Columns.Count).End(xlToLeft).column 

    If total > 0 Then 

    'Dim headcol As Integer 
    'headcol = 1 

    'origin.cells(3, headcol).Copy 
    'destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 


    For Each C In rng 
     If C = 14 Then 
       origin.cells(origrow, 1).Copy 
       destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 
       destination.cells(1, descolstart + 1).Value = "\{TAB}" 
       descolstart = descolstart + 1 
       origrow = origrow + 1 
     End If 
    Next C 

    destination.Columns("A:U").insert Shift:=xlToRight 
    Call headers 


    Else 'Donothing 


    End If 

    MsgBox total 

    End Sub** 

Answer 1

destination.cells(1, descolstart).PasteSpecial Paste:=xlPasteValues 
destination.cells(1, descolstart + 1).Value = "\{TAB}" 
descolstart = descolstart + 1 

您正在覆盖您刚写下的"\{TAB}"，在下一次迭代中。在每次迭代中，descolstart必须增加2，因为每次迭代消耗两列。

descolstart = descolstart + 2 ' <------------ +2, not +1