Можно ли упростить этот макрос, чтобы проверить, пуста ли ячейка, а затем сохранить соответствующие листы?

Question

Я пытаюсь создать макрос 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

Answer 1

Вы можете интегрировать этот маленький селектор в свой макрос, вызвав его, например, SelectSheets 3:

Sub SelectSheets(lCount As Long)
Dim lLoop As Long

If lLoop >= 1 Then Sheets(Array("L12", "L13-24", "L25-36")).Select

For lLoop = 2 To lCount

    Sheets("L12 (" & lLoop & ")").Select False
    Sheets("L13-24 (" & lLoop & ")").Select False
    Sheets("L25-36 (" & lLoop & ")").Select False

Next

End Sub

Answer 2

Посмотрите, будет ли это то, что вы ожидаете:

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