恳请高手帮忙解决一个从同一个文件夹内寻找不同数据的难题

qiongmei6

我希望在“寻找不同的资料”的表格中求得一个代码，当他执行的时候，他会在同一个文件夹内寻找其他文件夹的sheet29，找出每个文件内b列不同的内容显示在“寻找不同的资料”的a3：d，这个同一个文件夹内的除了“寻找不同的资料”的其他文件都是一样格式的，目前的“寻找不同的资料”就是我希望最终得到的结果，再次谢谢高手师傅的帮忙。

sdytsxd991122

我的理解能力有点低

fanyoulin

用双字典做的：

1、要把不带宏的原文件“寻找不同的资料.xls”删除，不然这个不带宏的原文件也会被统计在内；
2、模拟输出在第 20 行，原来的样本输出没有删掉，用以印证准确性；
     代码有个输出行参数 hs=20，如果觉得代码可行，再自行修改成 hs=2；
3、建议在最前面再增加一行清屏代码，用以先清除原有结果；
     因为保留了你的样本输出，所以清屏代码我没写，就一行，你自己加上去即可；

全党

shiyishi.......................................

grf1973

https://club.excelhome.net/thread-1663320-1-1.html
刚刚做的。把示例里的“A有B没有”，“A没有B有”加起来即为本例结果。

全党

全党 发表于 2023-5-22 14:28
shiyishi.......................................

Sub shishi()
Excel.Application.ScreenUpdating = False
Excel.Application.DisplayAlerts = False
Set dic = CreateObject("Scripting.Dictionary")
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(p & f)
            arr = wb.Sheets("汇总3").[a1].CurrentRegion
            For i = 2 To UBound(arr)
               If arr(i, 2) <> "" Then
               If Not dic.exists(arr(i, 2)) Then
                dic(arr(i, 2)) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4))
                Else
                dic.Remove (arr(i, 2))
                End If
               End If
            Next
            wb.Close False
        End If
        f = Dir
    Loop
[a1].CurrentRegion.Offset(3).ClearContents
[a3].Resize(dic.Count, 4) = Application.Rept(dic.items, 1)
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
End Sub

limonet

代码审核中。

limonet

类似于UNIQUE
Sub limonet()
    Dim Cn As Object, FileName$, Path$, StrSQL$
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data source=" & ThisWorkbook.FullName
    Path = ThisWorkbook.Path & "\"
    FileName = Dir(Path & "*.xls")
    Do While FileName <> ""
        If Split(FileName, ".xls")(0) <> "寻找不同的资料" Then
            StrSQL = StrSQL & "select * from [Excel 12.0;DataBase=" & Path & FileName & "].[汇总3$A:D] Union All "
        End If
        FileName = Dir
    Loop
    StrSQL = "Select 幼儿园,银行帐号,first(姓名),first(合计金额) from (" & Left(StrSQL, Len(StrSQL) - 11) & ")group by 幼儿园,银行帐号 having count(*)=1"
    Range("A3").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

qiongmei6

limonet 发表于 2023-5-22 16:39
类似于UNIQUE
Sub limonet()
    Dim Cn As Object, FileName$, Path$, StrSQL$

谢谢limonet师傅的回答，但是在我电脑上运行出现错误，如图

limonet

qiongmei6 发表于 2023-5-22 17:46
谢谢limonet师傅的回答，但是在我电脑上运行出现错误，如图

是不是office是03的？