时间戳

首页 > 解决方案 > 我可以简化此宏以检查单元格是否为空然后保存相应的工作表吗？

excel - 我可以简化此宏以检查单元格是否为空然后保存相应的工作表吗？

问题描述

我正在尝试创建一个 Excel VBA 宏来一次查看一个单元格的列表，以检查它是否为空，然后保存相应数量的工作表，该数量等于非空单元格数量的 3 倍。

这是我正在做的事情的代码。我想过在循环中使用循环，但我不确定如何实现它或者它是否会工作，所以我使用了这个，它确实有效。

Sub SaveMacro()

    Dim Cell As Variant
    Dim bFileSaveAs As Boolean

    'For j = 0 To 12
    Set Cell = Range("B3")


    If Not IsEmpty(Cell) Then
        Sheets(Array("L12", "L13-24", "L25-36")).Select

    If Not IsEmpty(Cell.Offset(1, 0)) Then
        Sheets(Array("L12", "L13-24", "L25-36", "L12 (2)", "L13-24 (2)", "L25-36 (2)")).Select

    If Not IsEmpty(Cell.Offset(2, 0)) Then
        Sheets(Array("L12", "L13-24", "L25-36" _
        , "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
        , "L12 (3)", "L13-24 (3)", "L25-36 (3)")).Select

    If Not IsEmpty(Cell.Offset(3, 0)) Then
        Sheets(Array("L12", "L13-24", "L25-36" _
        , "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
        , "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
        , "L12 (4)", "L13-24 (4)", "L25-36 (4)")).Select

    If Not IsEmpty(Cell.Offset(4, 0)) Then
        Sheets(Array("L12", "L13-24", "L25-36" _
        , "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
        , "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
        , "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
        , "L12 (5)", "L13-24 (5)", "L25-36 (5)")).Select

    If Not IsEmpty(Cell.Offset(5, 0)) Then
        Sheets(Array("L12", "L13-24", "L25-36" _
        , "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
        , "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
        , "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
        , "L12 (5)", "L13-24 (5)", "L25-36 (5)" _
        , "L12 (6)", "L13-24 (6)", "L25-36 (6)")).Select



    End If
    End If
    End If
    End If

        Sheets("L12").Activate
    bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show

End Sub

标签： excelvba

解决方案

看看这是否符合您的预期：

Sub SaveMacro()

    Dim Cell As Range: Set Cell = Range("B3")
    Dim sFileSaveAs As String
    Dim R As Long, Z As Long, X As Long
    Dim strSheets As String: strSheets = "L12,L13-24,L25-36"
    Dim arrSheets(1 To 6) As Variant
    Dim arrSheet() As String: arrSheet = Split(strSheets, ",")

    For R = LBound(arrSheets) To UBound(arrSheets)
        If R = 1 Then
            arrSheets(R) = arrSheet
        Else
            arrSheets(R) = strSheets
            For Z = 2 To R
                For X = LBound(arrSheet) To UBound(arrSheet)
                    arrSheets(R) = arrSheets(R) & "," & arrSheet(X) & " (" & Z & ")"
                Next X
            Next Z
            arrSheets(R) = Split(arrSheets(R), ",")
        End If
    Next R

    For R = Cell.Row + 5 To Cell.Row Step -1
        If Not IsEmpty(Cells(R, "B")) Then
            Sheets(arrSheets(R - 2)).Copy
            Exit For
        End If
    Next R

    sFileSaveAs = ThisWorkbook.Path & "\range of sheets.xlsm"
    ActiveWorkbook.SaveAs sFileSaveAs

End Sub

推荐阅读