使用列表框循环访问特定工作表 – VBA

我试图通过多个工作表循环，并find超过一定的阈值的值。 如果find这些值，则应将包含超过阈值的整行复制到新创build的“摘要”表格中。

我的UserForm到目前为止是这样的：

而我的代码是这样的：

Option Explicit Private Sub UserForm_Initialize() Dim N As Long For N = 1 To ActiveWorkbook.Sheets.Count Sheets_txt.AddItem ActiveWorkbook.Sheets(N).Name Next N End Sub Private Sub CommandButton1_Click() Dim SelectedItems As String Dim column As String Dim WS As Worksheet Dim i As Long, j As Long, lastRow As Long, k As Long Dim sh As Worksheet Dim sheetsList As Variant Dim threshold As Long Set WS = ThisWorkbook.Worksheets.Add WS.Name = "Summary" threshold = Me.Threshold_txt.Value column = Me.Column_txt.Value j = 2 For k = 0 To Sheets_txt.ListCount - 1 If Sheets_txt.Selected(i) = True Then SelectedItems = SelectedItems & Sheets_txt.List(i) lastRow = SelectedItems.Cells(SelectedItems.Rows.Count, "A").End(xlUp).Row For i = 4 To lastRow If SelectedItems.Range(column & i) > threshold Or SelectedItems.Range(column & i) < -threshold Then SelectedItems.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j) WS.Range("N" & j) = SelectedItems.Name j = j + 1 End If Next i End If Next k WS.Columns("A:N").AutoFit End Sub Private Sub CommandButton2_Click() Unload Me End Sub 

不过，我正在用For循环。 代码应该循环遍历所有选定的表单，并执行我上面写的东西。 但是，使用variablesSelectedItems来存储满足条件的所有stringIf Sheets_txt.Selected(i) = True不起作用。 在我的情况下，它debugginglastRow = SelectedItems.Cells(SelectedItems.Rows.Count, "A").End(xlUp).Row并指向(SelectedItems.Rows.Count 。

我怎样才能得到这个循环工作？ 任何帮助感激！

Answer 1

你可以试试这个（未经testing的）代码。

更新：这个问题的编辑做了一些细微的改变，build议现在testing这个代码。

 Option Explicit Private Sub UserForm_Initialize() Dim N As Long For N = 1 To ActiveWorkbook.Sheets.Count Sheets_txt.AddItem ActiveWorkbook.Sheets(N).Name Next N End Sub Private Sub CommandButton1_Click() Dim SelectedItems As String Dim column As String Dim WS As Worksheet Dim i As Long, j As Long, lastRow As Long, k As Long Dim sh As Worksheet Dim sheetsList As Variant Dim threshold As Long Set WS = ThisWorkbook.Worksheets.Add WS.Name = "Summary" threshold = Me.Threshold_txt.Value column = Me.Column_txt.Value j = 1 For k = 0 To Sheets_txt.ListCount - 1 If Sheets_txt.Selected(k) = True Then With Worksheets(Sheets_txt.List(k)) lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 4 To lastRow If .Cells(i, column) > threshold Or .Cells(i, column) < -threshold Then j = j + 1 Intersect(.Range("A:N"), .Cells(i, column).EntireRow).Copy Destination:=WS.Cells(j,2) WS.Cells(j, "A")= .Name End If Next End With If WS.Cells(j, "A")= .Name then j = j + 1 '<--| add a blank line if current sheet has produced at least one pasted line End If Next WS.Columns("A:N").AutoFit End Sub Private Sub CommandButton2_Click() Me.Hide 'and move the 'Unload' command in the sub calling the userform End Sub