Запуск специфицированного макроса c на всех листах, кроме именованных в Excel, с использованием VBA - PullRequest
0 голосов
/ 20 января 2020

У меня есть код, который вызывает другие макросы для запуска на указанных листах.

Во-первых: мне было интересно, как сказать, чтобы он запускал другой макрос на всех оставшихся листах, которых еще не было в списке

Во-вторых: я хочу, чтобы вышеуказанный макрос запускался на остальных листах, исключая количество именованных листов (например, «графики»)

Вот мой код на данный момент

Sub specify_sheets()

'apply appropriate limits to relative sheet

Dim sht As Worksheet

For Each sht In Worksheets
    If sht.Name = Worksheets("NB12") Or _
       sht.Name = Worksheets("NB15") Then
        Call limits_Alluvium
    End If

    If sht.Name = Worksheets("NB24") Then
        Call limits_BOCOBOML_GFA

    End If

    If sht.Name = Worksheets("NB16") Or _
       sht.Name = Worksheets("NB17") Or _
        sht.Name = Worksheets("NB19") Or _
        sht.Name = Worksheets("NB20") Or _
       sht.Name = Worksheets("Bore 31") Then
       Call limits_BOCOBOML_MIA

    End If

    If sht.Name = Worksheets("Bore 47") Or _
       sht.Name = Worksheets("Bore 48") Then
       Call limits_FracturedRock_GFA

    End If

        If sht.Name = Worksheets("Bore 4") Or _
       sht.Name = Worksheets("Bore 4a") Or _
        sht.Name = Worksheets("Bore 40") Then
       Call limits_FracturedRock_MIA_West

    End If

        If sht.Name = Worksheets("Bore 30") Then
       Call limits_FracturedRock_MIA_East

    End If

Next sht


End Sub

Вот код одного из макросов, к которым он обращается:

Sub limits_Monitoring_bores()

        Dim sht As Worksheet, lastRow As Long
        Set sht = ActiveWorkbook.Worksheet

'Name columns appropriately


 With ActiveWorkbook.Worksheets(1)
    .Cells(1, 4).Value = "Min"
    .Cells(1, 5).Value = "Max"
    .Cells(1, 7).Value = "20th Percentile"
    .Cells(1, 8).Value = "80th Percentile"
    .Cells(1, 10).Value = "20th Percentile"
    .Cells(1, 11).Value = "80th Percentile"

End With

        lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
        sh.Range("D2:D" & lastRow).Value = "=6"
        sh.Range("E2:E" & lastRow).Value = "=8.5"
        sh.Range("G2:G" & lastRow).Value = "=PERCENTILE(F:F,0.2)"
        sh.Range("H2:H" & lastRow).Value = "=PERCENTILE(F:F,0.8)"
        sh.Range("J2:J" & lastRow).Value = "=PERCENTILE(I:I,0.2)"
        sh.Range("K2:K" & lastRow).Value = "=PERCENTILE(I:I,0.8)"

End Sub

1 Ответ

1 голос
/ 20 января 2020

Это должно работать для вас: -

Sub STO()

    Dim Fun As String    
    Dim Sht As Worksheet

    For Each Sht In Worksheets
        Select Case Sht.Name
            Case "NB12", "NB15"
                limits_Alluvium
            Case "NB24"
                limits_BOCOBOML_GFA
            Case "NB16", "NB17", "NB19", "NB20", "Bore 31"
                limits_BOCOBOML_MIA
            Case "Bore 47", "Bore 48"
                limits_FracturedRock_GFA
            Case "Bore 4", "Bore 4a", "Bore 40"
                limits_FracturedRock_MIA_West
            Case "Bore 30"
                limits_FracturedRock_MIA_East
            Case Else
                If Len(Fun) Then Fun = Fun & vbCr
                Fun = Fun & Sht.Name
        End Select
    Next Sht
    MsgBox Fun, vbInformation, "Sheets not processed"
End Sub

Листы, нигде не перечисленные, не будут обрабатываться.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...