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

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

我想要做的是macros观检查是否一个特定的单元格（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