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

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

0 个答案: