循环播放如果没有为第二条指令工作

时间:2017-06-03 09:17:53

标签: excel excel-vba excel-2010 vba

我在Excel VBA中相对较新,而我正在做的是我们的ERP之一的加载器。所以我的问题是这个...我有一个excel工作表,让我们把它称为原点和另一个,我们称之为虚拟。

我想要做的是宏检查原点范围内的某个单元格(af18)是否符合标准。如果是真的,则将A18从原始表复制到虚拟表。然后在下一列插入“{tab}。然后如果AF19(下一个单元格)符合条件,则将a19复制到虚拟的下一个空白列,然后再次插入{tab}。

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

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

enter image description here

  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**

1 个答案:

答案 0 :(得分: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