多个工作簿条件筛选后汇总，请高手帮忙写个VBA，送花花

罗达

一柱 发表于 2023-3-4 18:07
这个是用sql语句，需要安装什么对吧，我wps好像用不了，还是非常感谢。
conn.Open "Provider=Microsoft. ...

替换成这一句试试
"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=excel 8.0;Data Source=" & ThisWorkbook.Path & "/" & arr(k, 1);

一柱

gwjkkkkk 发表于 2023-3-4 15:16
请解压后使用。。。

今天试了一下很好用，如果希望贴过去保持文本格式，不要把我O列的公式去掉了，能帮再完善一下不。
我原数据其实O列是有其他公式的，运行后公式没了，只有数字不知道原因在哪

gwjkkkkk

一柱 发表于 2023-3-7 17:39
今天试了一下很好用，如果希望贴过去保持文本格式，不要把我O列的公式去掉了，能帮再完善一下不。
我原 ...

o列是不会去除公式的，你再试一下。。。

一柱

gwjkkkkk 发表于 2023-3-7 18:02
o列是不会去除公式的，你再试一下。。。

数值粘帖，或贴过去保持文本格式,我在这里加上这句好像不起作用，详见倒数第5行，红色字体，请教方法


Sub test()
    Dim ar, br, i&, j&, r&, f, p$  
    Application.ScreenUpdating = False
    With [A1].CurrentRegion
        ar = .Resize(10 ^ 3)
        r = .Rows.Count
    End With
    p = ThisWorkbook.Path & "\"
    For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(p).Files
        If f.Name Like "*.xlsx" Then
            With GetObject(f)
                With .Sheets(1)
                    br = .[A1].CurrentRegion
                    For i = 3 To UBound(br)
                        If (br(i, 7) = "S202300108" Or br(i, 7) = "S202300109") And br(i, 10) = "20220225" Then
                            r = r + 1
                            For j = 1 To UBound(br, 2)
                                ar(r, j) = br(i, j)
                            Next j
                        End If
                    Next i
                End With
                .Close False
            End With
        End If
    Next
    [A1].Columns(1).NumberFormatLocal = "@"
    [A1].Resize(r, UBound(ar, 2)) = ar
    Application.ScreenUpdating = True
    Beep
End Sub

山海风云轩

学习一下，，，，，，

全党

用数组写了一个，试一下。不会sql。

gwjkkkkk

一柱 发表于 2023-3-7 18:36
数值粘帖，或贴过去保持文本格式,我在这里加上这句好像不起作用，详见倒数第5行，红色字体，请教方法

...

Columns(1).NumberFormatLocal = "@"