excel VB代码

Sub look()
    Dim xCount%, yCount%, a$, b$
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim mypath$, myname$
    mypath = ThisWorkbook.Path & "\数据源\"
    myname = Dir(mypath & "*.*")
   ' MsgBox myname
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(mypath & myname)
    xCount = wb.Sheets(1).UsedRange.Rows.Count
    yCount = wb.Sheets(2).UsedRange.Rows.Count
    For i = 2 To xCount
        'A为表1的家庭住列
        a = wb.Sheets(1).Range("A" & i)
        For j = 2 To yCount
           'A为表2的查找匹配项的数据列
           b = wb.Sheets(2).Range("A" & j)
           If InStr(a, b) Then
                'MsgBox "OK"
                'B列是新增的 县列 随实际情形设置
                wb.Sheets(1).Range("B" & i) = b
                Exit For
           End If
        Next
    Next
    
    Application.ScreenUpdating = True
End Sub

a b 定义两列 data是文件件就说数据源

Sub look()
    Dim xCount%, yCount%, a$, b$, aa$, bb$
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim mypath$, myname$
    mypath = ThisWorkbook.Path & "\Data\"
   
    myname = Dir(mypath & "*.*")
    
    Application.ScreenUpdating = False
    Do While myname <> ""
        Set wb = Workbooks.Open(mypath & myname)
        xCount = wb.Sheets(1).UsedRange.Rows.Count
        
        '行循环
        For x = 1 To xCount
            a = wb.Sheets(1).Range("A" & x)
            b = wb.Sheets(1).Range("B" & x)
            aa = ThisWorkbook.Sheets(1).Range("A" & x)
            bb = ThisWorkbook.Sheets(1).Range("B" & x)
            
            ThisWorkbook.Sheets(1).Range("A" & x) = aa & a
            ThisWorkbook.Sheets(1).Range("B" & x) = bb & b
        Next
        wb.Close
        myname = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub