Question

我运行以下代码，VBA只闪烁一毫秒，没有给出结果。无论我如何编辑代码，VBA都不会执行它。

我很困惑。但是，如果我运行我的原始代码，它的工作原理......我尝试对原始代码进行相同的编辑，VBA会运行，但会在几次尝试后停止运行。

有谁知道到底发生了什么事？

启动代码：

Sub LeadDetailsQR()

    Dim OgData As String
    OgData = ActiveSheet.Name

    Sheets(OgData).AutoFilterMode = False
    varMyData = Sheets(OgData).Range("AK2", Range("AK" & Rows.Count).End(xlUp)).Value

    With CreateObject("scripting.dictionary")

        For Each varItem In varMyData
            If Not IsEmpty(varItem) Then .Item(varItem) = Empty
        Next varItem

        For Each varItem In .keys

            Cells.AutoFilter
            Sheets.Add Before:=ActiveSheet

            Application.DisplayAlerts = False
            On Error Resume Next
            ActiveWorkbook.Worksheets(varItem).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True

            ActiveSheet.Name = varItem
            Sheets(OgData).Select
            Sheets(OgData).Range("AK1").AutoFilter Field:=37, Criteria1:=varItem
            Sheets(OgData).Cells.CurrentRegion.Copy
            Sheets(varItem).Cells.PasteSpecial Paste:=xlPasteColumnWidths
            Sheets(OgData).Cells.CurrentRegion.Copy
            Sheets(varItem).Cells.PasteSpecial Paste:=xlPasteAll

        Next varItem

    End With

    Sheets(OgData).AutoFilterMode = False

End Sub

原始代码（有效）：

Sub LeadDetailsQROriginal()

    Dim OgData As String
    OgData = ActiveSheet.Name

    Sheets(OgData).AutoFilterMode = False
    varMyData = Sheets(OgData).Range("A2", Range("A" & Rows.Count).End(xlUp)).Value

    With CreateObject("scripting.dictionary")
        For Each varItem In varMyData
            If Not IsEmpty(varItem) Then .Item(varItem) = Empty
        Next varItem
        For Each varItem In .keys
            Sheets.Add Before:=ActiveSheet
            ActiveSheet.Name = varItem
            Sheets(OgData).Range("A1").AutoFilter Field:=1, Criteria1:=varItem
            Sheets(OgData).Select
            Sheets(OgData).Range("A1").CurrentRegion.Copy
            Sheets(varItem).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Sheets(OgData).Range("A1").CurrentRegion.Copy
            Sheets(varItem).Range("A1").PasteSpecial Paste:=xlPasteAll
        Next varItem
    End With

    Sheets(OgData).AutoFilterMode = False

End Sub

Answer 1

我很尴尬地说我找到了答案。代码正在完成它正在做的事情。它运行时没有错误，因为它查找的范围是空白的，因此不会创建任何内容。

如果我不清楚，请让我解释一下代码。代码应该根据列中的每个唯一值创建一个新工作表。代码运行时没有产生任何结果，因为我要求代码查看列AK，这是一个空白列。所以当然它没有产生任何东西：）

我的代码没有执行

1 个答案: