excel - 搜索非空白字符串并返回范围

Question

我需要宏的帮助以允许用户首先选择一个文件夹，然后使用该宏运行该工作簿中的每个工作簿和每个工作表，搜索特定范围内的非空白单元格并返回同一行的范围。

例如，搜索 A1:A10，如果 A2 中有一个非空白单元格，则在主表的下一个可用行上返回 A2:F2。

这些工作表都有不同的名称，因为它们与我们其中一个分支机构的城市有关。

我有一个宏可以做到这一点，但我觉得它效率不高，并相信有一种更简单的方法来解决这个问题。它也不允许用户选择一个文件夹，它设置一个静态的，但不会每次都是这样。我实际上有这个宏调用副本 3 次，范围略有不同，因为第一个将搜索 A1:A10 并返回例如 A1:F1，如果它不是空白，下一个宏将搜索 T1:T10 并返回T1:W1 如果它不是空白等

Sub Search1()

    Dim stgF As String, stgP As String
    Dim lr As Long, nr As Long, lr1 As Long
    Dim wb As Workbook
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Search 
    Results 1") 
    Dim sh As Worksheet

    stgP = "C:\Test"  
    stgF = Dir(stgP & "\*.xls*")


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Do While stgF <> vbNullString

    Set wb = Workbooks.Open(stgP & "\" & stgF)

    For Each sh In wb.Worksheets
        lr1 = sh.Range("A" & Rows.Count).End(xlUp).Row
        If lr1 > 1 Then
            sh.Range("A7:F37" & lr1).Copy
            ws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                    nr = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row + 1
                    ws.Range("N" & nr & ":N" & lr) = wb.Name & "," & " " & sh.Name 
                    ws.Columns("A:N").AutoFit
            End If
    Next sh

        wb.Close Save = False
        stgF = Dir()
    Loop

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    Call Search2
    End Sub

标签： excelvba