求助VBA大神，数据表录入更新时老卡了，求代码优化

luoxiuya1314

客户太多的情况，数据一同步，excel直接白屏或者卡，看不能用VBA解决，跪求VBA大神~！

mmwwdd

mmwwdd

给你做了一个试试吧

zxsea_7426

zpy2

如果同步频繁，建议动态按需生成

luoxiuya1314

zxsea_7426 发表于 2023-2-27 07:09

大神，出现“运行时错误”提示

zpy2

luoxiuya1314 发表于 2023-2-27 20:08
大神，出现“运行时错误”提示

苹果电脑？

luoxiuya1314

zpy2 发表于 2023-2-27 20:54
苹果电脑？

不是，普通办公电脑

luoxiuya1314

mmwwdd 发表于 2023-2-27 06:02
给你做了一个试试吧

大神，Dim ws As Worksheet，选中全部工作表，如果想加一段（其中“客户汇总”工作表除外），代码怎么表达

今日123

这是借鉴上面两位老师的代码写的试试
Sub 拆分()
Dim cnn, rs As Object, dic As Object, sh As Worksheet
Dim MySQL$, i, k, sht, rw, arr

Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set dic = CreateObject("Scripting.Dictionary")
DoApp False
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
For Each sh In Sheets
    If sh.Name <> "客户日常数据" And sh.Name <> "客户汇总" Then sh.Delete
Next sh
With Sheets("客户日常数据")
    arr = .[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If Not dic.exists(arr(i, 2)) Then
            dic(arr(i, 2)) = ""
        End If
    Next i
End With
For Each k In dic.keys
    Set sht = Sheets.Add
    With sht
        .Name = k
        .Move after:=Sheets(Sheets.Count)
        With .[a1]
            .Value = k
            .Font.Size = 14
            .Font.Bold = True
        End With
        .[a2].Resize(1, 4) = Array("日期", "项目", "应收", "已收")
        MySQL = "select 日期,项目,应收,已收 from [客户日常数据$] where 客户名称='" & .Name & "'"
        rs.Open MySQL, cnn, 1, 3
        .Range("A3").CopyFromRecordset rs
        .Columns("A:A").NumberFormatLocal = "m""月""d""日"""
        .Columns("C:D").NumberFormatLocal = "#,##0.00"
        rs.Close
        rw = .[a1048576].End(3).Row
        .[c1].Formula = "=sum(C3:C" & rw + 1 & ")"
        .[d1].Formula = "=sum(d3:d" & rw + 1 & ")"
        With .[c1:d1]
            .Font.Size = 14
            .Font.Bold = True
        End With
        .Cells.EntireColumn.AutoFit
    End With
Next k
DoApp
End Sub
Function DoApp(Optional b As Boolean = True)
  With Application
    .ScreenUpdating = b
    .DisplayAlerts = b
    .Calculation = IIf(b, -4105, -4135)
  End With
End Function