Question

我正在尝试为excel创建一些VBA代码，这样我就可以将许多产品中的数据复制到与产品同名的新工作表中。每个产品的不同数据由一列日期分隔，这些日期未复制到新工作表中。我创建了以下代码，它适用于一个产品，但是当我添加第二个产品时代码出错了。而不是从第二个产品复制第一列，它再次复制上一个产品的第三列，然后直接跳转到第二个产品的第二列。所以代码遗漏了第二个产品的第一列。

Sub Forecast_Products()
 Dim iterations As Integer
 iterations = Cells(68, 1).Value
 Dim i As Integer, j As Integer
 For i = 1 To iterations
    Cells(69, i).Value = 0
    For j = 2 To 6 Step 2
        Dim startCell As String, endCell As String
        startCell = Col_Letter(j + 7 * (i - 1)) & "9"
        endCell = Col_Letter(j + 7 * (i - 1)) & "60"
        Range(startCell, endCell).Select
        Dim salesCount As Integer
        salesCount = Cells(69).Value
        Cells(69).Value = salesCount + Application.WorksheetFunction.CountIf(Range(startCell, endCell), ">=0")
        Selection.Copy
        Dim productName As String
        Sheets("Input").Activate
        productName = Cells(70, i).Value
        MsgBox (productName & " 70, " & CStr(i))
        Sheets(productName).Activate
        Dim rowStart As Variant
        rowStart = CStr(11 + (52 * (j / 2 - 1)))
        Range("B" & rowStart).Select
        Selection.PasteSpecial xlValue
        Range("M" & rowStart).Select
        Selection.PasteSpecial xlValue
        Sheets("Input").Activate
    Next
    Dim rowCount As Integer
    rowCount = Cells(69, i).Value + 10
    Sheets(Cells(70, i).Value).Activate
    For j = 4 To 8
        Dim formula As Variant
        formula = Cells(17, j).Copy
        startCell = Col_Letter(j) & "18"
        endCell = Col_Letter(j) & CStr(rowCount)
        Range(startCell, endCell).Select
        Selection.PasteSpecial xlAll
    Next
Next

End Sub

Function Col_Letter(lngCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

Answer 1

解决问题。第二个产品的第一个循环没有返回到输入表。这是固定代码。

Sub Forecast_Products()
 Dim iterations As Integer
 iterations = Cells(68, 1).Value
 Dim i As Integer, j As Integer
 For i = 1 To iterations
    Cells(69, i).Value = 0
    For j = 2 To 6 Step 2
        Dim startCell As String, endCell As String
        startCell = Col_Letter(j + 6 * (i - 1)) & "9"
        endCell = Col_Letter(j + 6 * (i - 1)) & "60"
        Sheets("Input").Activate
        Range(startCell, endCell).Select
        Dim salesCount As Integer
        salesCount = Cells(69).Value
        Cells(69).Value = salesCount + Application.WorksheetFunction.CountIf(Range(startCell, endCell), ">=0")
        Selection.Copy
        Dim productName As String
        Sheets("Input").Activate
        productName = Cells(70, i).Value
        'MsgBox (productName & " 70, " & CStr(i))
        Sheets(productName).Activate
        Dim rowStart As Variant
        rowStart = CStr(11 + (52 * (j / 2 - 1)))
        Range("B" & rowStart).Select
        Selection.PasteSpecial xlValue
        Range("M" & rowStart).Select
        Selection.PasteSpecial xlValue
        Sheets("Input").Activate
    Next
    Dim rowCount As Integer
    rowCount = Cells(69, i).Value + 10
    Sheets(Cells(70, i).Value).Activate
    For j = 4 To 8
        Dim formula As Variant
        formula = Cells(17, j).Copy
        startCell = Col_Letter(j) & "18"
        endCell = Col_Letter(j) & CStr(rowCount)
        Range(startCell, endCell).Select
        Selection.PasteSpecial xlAll
    Next
Next

End Sub

Function Col_Letter(lngCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

列的复制不正确

1 个答案: