有的人看上去是精算师，其实是魔法少女——如何用VBA快速跨表找记录

Mengkelyu

作为一个精算师，我们经常会跨很多excel表处理数据。
最近珂珂研究了一款小工具，可以用来在不手动打开Excel文件的情况下寻找一个字段在哪些Excel工作薄里出现了。
小工具如下图。是不是有一种在使用魔法的感觉呢！嘿嘿工作彷佛都有趣了很多。

Mengkelyu

先看看如何使用吧。在Path单元格下方写入要寻找的Excel的路径，多少没有限制。右边的"D1“单元格写要查找的值。点击Magic就可以啦

点击后弹出了对话框

点击”是“后就可以运行宏啦。
如果在某个工作薄中能找到这个字段，就会弹窗弹出工作薄的名字，并在Output这个工作表中输出所有可以找到该字段的工作薄的名称。

Mengkelyu

核心代码，path是写着"Path"的单元格的名字哦，怎么给单元格起名往期已经介绍过啦！

‘Read paths 
path = Range("path").CurrentRegion.Value
    
    For i = 2 To UBound(path, 1)
        
        'Open workbook in invisible read only mode
        Set wbResults = Workbooks.Open(Filename:=path(i, 1), UpdateLinks:=0, ReadOnly:=True)
        wbResults.Windows(1).Visible = False
        'Run WorksheetLoop Macro
        Call WorksheetLoop(wbResults, lookforvalue)
        'Close workbook
        wbResults.Close SaveChanges:=False
    Next i

细心的小朋友可以注意到，上面的代码用了"WorksheetLoop"这个宏。
这个宏如下

Private Sub WorksheetLoop(wb As Workbook, what_to_look_for)
    
    Dim sh          As Worksheet, loc As Range
'Loop through worksheets
    For Each sh In wb.Worksheets
        With sh.UsedRange
            Set loc = .Cells.Find(What:=what_to_look_for)
            If Not loc Is Nothing Then
               'op is the code name of worksheet "output"
                If op.Range("A2") = "" Then
                    op.Range("A2") = wb.Name
                Else
                    op.Range("A1").End(xlDown).Offset(1, 0) = wb.Name
                End If
                MsgBox "Found in " & wb.Name
                Exit Sub
            Else
                
            End If
        End With
        Set loc = Nothing
    Next
    MsgBox "Not found in " & wb.Name
    
End Sub

注意可以用Private Sub，因为我们不需要在工作薄里使用它，只需要在别的Public宏中使用即可。

Mengkelyu

record finding tool.zip
原工作薄附上~ 把代码稍作修改，就可以用于别的跨表工作哦。嘻嘻。