Question

我很擅长VBA并试图开发一个宏。我从包含A到S列数据的访问数据库输出。输出具有可变数量的行但始终包含标题行。 C列具有多行共有的值（即C2：C7可能是'Bananas'，而C8：C9可能是'Basket'，而C10：C21可能是'Bucket'），但是具有C列中的公共值是动态的。 C列中的值始终是连续的。

我一直在尝试创建一个宏：识别列C中的值何时更改，将列C中的具有相同值的行（以及标题行）的列A到S粘贴到保存在其中的新工作簿列C值作为文件名，从原始工作簿中删除此范围，并循环列C中的值数。如果列C中有3个值，我的代码似乎有效;但是，如果超过此值，代码似乎忽略了在C列中查找值更改的条件，并创建了包含C列中包含多个值的范围的新工作簿。

我认为这可能是由于变量没有为循环的每次迭代清除，但我在网上看到的所有内容都表明这不应该是一个问题。当我用msgbox替换新的工作簿代码时，If语句似乎有效，但是没有工作簿代码。我认为For循环存在问题，但我不确定如何解决这个问题。我用Google搜索并查看了无数的SO页面，但找不到我可以使用的答案。任何帮助将非常感激。

这是我的代码：

Sub number()

    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    Dim cell, rng As Range
    Set rng = Range("C2:C97")

    For Each cell In rng
        If cell.Value <> cell.Offset(1, 0).Value Then

        Set wbI = ActiveWorkbook
        Set wsI = wbI.Worksheets("Worklist")
        Set wbO = Workbooks.Add

            With wbO
                 Set wsO = wbO.Sheets("Sheet1")
                .SaveAs Filename:="C:\Users\svanwo0\Desktop\" & cell & ".xls", FileFormat:=56
                wsI.Range("A1:S1").Copy
                wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                wsI.Rows("2:" & cell.Row).Copy
                wsO.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Close SaveChanges:=True
            End With
        Set wbI = Nothing
        Set wsI = Nothing
        Set wbO = Nothing
        Set wsO = Nothing

        Rows("2:" & cell.Row).EntireRow.Delete (xlUp)

        End If
    Next cell


End Sub

提前致谢

vanw0001

Answer 1

这是循环中前进并删除行会导致问题的实例之一。

您已设置要迭代的范围。当您删除数据时，数据会向上移动，但您仍然会转到下一个物理行，但每次都不会重置

由于你基本上删除了整个日期区域，我会等到最后删除。我会创建一个变量来保存下一个数据块的起始行。

Sub number()

    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    Dim cell, rng As Range
    Dim stRw As Long
    Set rng = Range("C2:C97")
    stRw = 2
    For Each cell In rng
        If cell.Value <> cell.Offset(1, 0).Value Then

        Set wbI = ActiveWorkbook
        Set wsI = wbI.Worksheets("Worklist")
        Set wbO = Workbooks.Add

            With wbO
                 Set wsO = wbO.Sheets("Sheet1")
                .SaveAs Filename:="C:\Users\svanwo0\Desktop\" & cell & ".xls", FileFormat:=56
                wsI.Range("A1:S1").Copy
                wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                wsI.Rows(stRw & ":" & cell.Row).Copy
                wsO.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Close SaveChanges:=True
                stRw = cell.Row + 1
            End With
        Set wbI = Nothing
        Set wsI = Nothing
        Set wbO = Nothing
        Set wsO = Nothing



        End If
    Next cell
    Rows("2:97").EntireRow.Delete (xlUp)

End Sub

根据循环列

1 个答案: