VBA-在工作簿中选择要循环使用的特定工作表

我有一个excel工作簿，其中的工作表数量可变。目前，我正在遍历所有的表格，其中有一个特定的列，以搜索高于某个阈值的数字。列和阈值由用户需要填写的输入框确定。如果列中的数字，比如说“J”列和第10行高于阈值，则复制第10行并粘贴到新创建的“摘要”表中

我目前正在为一系列特定的床单苦苦挣扎。我并不总是想循环浏览所有工作表，而是希望有另一个输入框或其他东西，我可以在其中选择循环浏览的特定工作表（STRG+“sheetx”“sheety”等？！有人知道我如何用我的代码实现这一点吗？我知道我必须更改我的“for each”语句以替换所选的工作表，但我不知道如何创建输入框以选择特定的选项卡

感谢您的帮助

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

选项显式
子测试（）
将列设置为字符串
将WS设置为工作表
我长，j长，最后一排长
将sh设置为工作表
变暗板材列表作为变型
模糊的阈值与长的阈值相同
设置WS=GetSheet（“摘要”，True）
阈值=应用程序.InputBox（“输入阈值”，类型：=1）
列=应用程序.InputBox（“货币列”，类型：=2）
j=2
对于ActiveWorkbook.Sheets中的每个sh
如果sh.名称为“摘要”，则
lastRow=sh.Cells（sh.Rows.Count，“A”）.End（xlUp）.Row
对于i=4到最后一行
如果sh.Range（第&i列）>阈值或sh.Range（第&i列）<-阈值，则
sh.Range（“a”&i&“：n”&i）.复制目标：=WS.Range（“a”&j）
WS.Range（“N”和j）=sh.Name
j=j+1
如果结束
接下来我
如果结束
下一个sh
WS.Columns（“A:N”）.AutoFit
端接头
函数GetSheet（shtName作为字符串，可选clearIt作为Boolean=False）作为工作表
出错时继续下一步
Set GetSheet=工作表（shtName）
如果GetSheet什么都不是，那么
设置GetSheet=Sheets.Add（之后：=工作表（Worksheets.Count））
GetSheet.Name=shtName
如果结束
如果是clearIt，则GetSheet.UsedRange.Clear
端函数

同意用户表单可以提供一种更具吸引力的定义方式，但InputBox方法也不错。以下代码创建了一个InputBox，它接受图纸范围条目的方式与打印对话框接受页码的方式相同，即使用逗号（1、3、9）分隔的显式图纸编号或使用连字符（1-9）分隔的范围

这看起来像很多代码，但它有一些错误处理来防止丑陋的失败。ActiveWorkbook.Sheets中每个sh的循环

，将替换为代码底部的循环

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

子表单loopInputBox（）
Dim mySheetsArr2（999）
'从inputbox收集工作表范围：
mySheets=Replace（输入框（“输入您希望处理的工作表编号，例如：”&vbNewLine&vbNewLine&_
“1-3”和vbNewLine&_
“1,3,5,7,15”、“工作表”和“工作表”
如果mySheets=“”然后退出Sub“用户单击取消或输入空白
'从字符串中删除空格：
如果InStr（mySheets，“”），那么mySheets=Replace（mySheets，“”，“”）
如果InStr（mySheets，“，”），则
'逗号分隔的值。。。
'创建数组：
mySheetsArr1=拆分（mySheets，“，”）
'测试用户是否通过尝试进行数学运算输入数字，并创建最终数组：
出错时继续下一步
对于i=0到UBound（mySheetsArr1）
mySheetsArr2（i）=mySheetsArr1（i）*1
如果错误号为0，则
呃，明白了
MsgBox“错误，无法理解工作表条目。”
出口接头
如果结束
接下来我
i=i-1
ElseIf InStr（mySheets，“-”）然后
'连字符分隔的范围值。。。
“检查，只有一个连字符
如果Len（mySheets）（Len（Replace（mySheets），“-”，“）+1），则
MsgBox“错误，无法理解工作表条目。”
出口接头
如果结束
'测试用户是否通过尝试数学输入数字：
出错时继续下一步
温度=拆分（mySheets，“-”）（0）*1
温度=拆分（mySheets，“-”）（1）*1
如果错误号为0，则
呃，明白了
MsgBox“错误，无法理解工作表条目。”
出口接头
如果结束
错误转到0
'创建最终数组：
i=0
i=i-1
对于j=Split（mySheets），“-”（0）*1到Split（mySheets），“-”（1）*1
i=i+1
mySheetsArr2（i）=j
下一个j
如果结束
'完成工作的循环：
'（处理存储在数组mySheetsArr2中的页码）：
对于j=0到i
"例一:
MsgBox mySheetsArr2（j）
"例二:
'Sheets（mySheetsArr2（j））.Cells（1,1）.Value=Now（）
'表（mySheetsArr2（j））.列（“A:A”）.自动拟合
下一个j
端接头
在“无用户窗体”状态下，您可以将
字典
对象和
应用程序.InputBox（）
方法组合使用，将其
类型
参数设置为
8
并使其接受
范围
选择：

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

此功能将
Parent
工作表名从用户切换工作表所选择的每个范围内获取，当用户单击
Cancel
按钮或关闭InputBox时停止

将由您的“主”子系统利用，如下所示：

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

Sub-main（）
将ws设置为工作表
对于每个ws-In-Sheets（GetSheets）”，由于您的数据需求开始变得更加具体，我建议您不要使用多个输入框，而是使用一个在一个弹出窗口中包含所有参数的用户表单。这样你就可以摆弄userform控件，它应该为你提供足够多的选项。我知道，我已经得到了使用UserForms的建议。然而