VBA - select specific sheets within workbook to loop through

问题

I have an excel workbook with a variable number of sheets. At the moment I am looping through all sheets and therein a specific column to search for figures above a certain threshold. Column and threshold are determined by inputboxes that need to be filled in by the user. If the figure in the column, let's say column "J" and row 10 is above threshold, row 10 is copied and pasted in a new created "summary" sheet etc.

I am struggling at the moment with a specific selection of sheets. I don't always want to loop through all sheets but instead would like to have another inputbox or something else in which I can select specific sheets (STRG + "sheetx" "sheety" etc...) that are looped through?! Anyone an idea how I can accomplish that with my code? I know that I have to change my "for each" statement to substitute for the selected sheets but I don't know how to create the inputbox to select specific tabs...

Any help appreciated!

Option Explicit

Sub Test()
    Dim column As String
    Dim WS As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim sh As Worksheet
    Dim sheetsList As Variant
    Dim threshold As Long

    Set WS = GetSheet("Summary", True)

    threshold = Application.InputBox("Input threshold", Type:=1)
    column = Application.InputBox("Currency Column", Type:=2)
    j = 2
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> "Summary" Then
            lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
            For i = 4 To lastRow
                If sh.Range(column & i) > threshold Or sh.Range(column & i) < -threshold Then
                    sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
                    WS.Range("N" & j) = sh.Name
                    j = j + 1
                End If
            Next i
        End If
    Next sh
    WS.Columns("A:N").AutoFit
End Sub

Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
    On Error Resume Next
    Set GetSheet = Worksheets(shtName)
    If GetSheet Is Nothing Then
        Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
        GetSheet.Name = shtName
    End If
    If clearIt Then GetSheet.UsedRange.Clear
End Function

回答1:

in the "NO-UserForm" mood you could use a combination of Dictionary object and the Application.InputBox() method when setting its Type parameter to 8 and have it accept range selections:

Function GetSheets() As Variant
    Dim rng As Range

    On Error Resume Next
    With CreateObject("Scripting.Dictionary")
        Do
          Set rng = Nothing
          Set rng = Application.InputBox(prompt:="Select any range in wanted Sheet", title:="Sheets selection", Type:=8)
          .item(rng.Parent.Name) = rng.Address
        Loop While Not rng Is Nothing
        GetSheets = .keys
    End With
End Function

this function gets the Parent sheet name out of each range selected by the user switching through sheets and stops when the user clicks the Cancel button or closes the InputBox

to be exploited by your "main" sub as follows:

Sub main()
    Dim ws As Worksheet

    For Each ws In Sheets(GetSheets) '<--| here you call GetSheets() Function and have user select sheets to loop through
        MsgBox ws.Name
    Next
End Sub

回答2:

Agreed that a UserForm could offer a more appealing way to define it, however the InputBox approach isn't bad. The following code creates an InputBox that accepts a sheet range entry in the same way as a print dialog accepts page numbers, i.e. either explicit sheet numbers separated by commas (1, 3, 9) or a range separated with a hyphen (1-9).

This will look like a lot of code but it's got some error handling to prevent ugly failures. Your loop For Each sh In ActiveWorkbook.Sheets would be replaced by a loop like the example at the bottom of the code.

Sub sheetLoopInputBox()
    Dim mySheetsArr2(999)

    'Gather sheet range from inputbox:
    mySheets = Replace(InputBox("Enter sheet numbers you wish to work on, e.g.:" & vbNewLine & vbNewLine & _
    "1-3" & vbNewLine & _
    "1,3,5,7,15", "Sheets", ""), " ", "")

    If mySheets = "" Then Exit Sub 'user clicked cancel or entered a blank

    'Remove spaces from string:
    If InStr(mySheets, " ") Then mySheets = Replace(mySheets, " ", "")

    If InStr(mySheets, ",") Then
        'Comma separated values...
        'Create array:
        mySheetsArr1 = Split(mySheets, ",")
        'Test if user entered numbers by trying to do maths, and create final array:
        On Error Resume Next
        For i = 0 To UBound(mySheetsArr1)
            mySheetsArr2(i) = mySheetsArr1(i) * 1
            If Err.Number <> 0 Then
                Err.Clear
                MsgBox "Error, did not understand sheets entry."
                Exit Sub
            End If
        Next i
        i = i - 1
    ElseIf InStr(mySheets, "-") Then
        'Hyphen separated range values...
        'Check there's just one hyphen
        If Len(mySheets) <> (Len(Replace(mySheets, "-", "")) + 1) Then
            MsgBox "Error, did not understand sheets entry."
            Exit Sub
        End If
        'Test if user entered numbers by trying to do maths:
        On Error Resume Next
        temp = Split(mySheets, "-")(0) * 1
        temp = Split(mySheets, "-")(1) * 1
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "Error, did not understand sheets entry."
            Exit Sub
        End If
        On Error GoTo 0
        'Create final array:
        i = 0
        i = i - 1
        For j = Split(mySheets, "-")(0) * 1 To Split(mySheets, "-")(1) * 1
            i = i + 1
            mySheetsArr2(i) = j
        Next j
    End If


    'A loop to do your work:
    '(work through the sheet numbers stored in the array mySheetsArr2):
    For j = 0 To i
        'example1:
        MsgBox mySheetsArr2(j)

        'example2:
        'Sheets(mySheetsArr2(j)).Cells(1, 1).Value = Now()
        'Sheets(mySheetsArr2(j)).Columns("A:A").AutoFit
    Next j
End Sub

来源：https://stackoverflow.com/questions/42325891/vba-select-specific-sheets-within-workbook-to-loop-through