小白求助。我有一张汇总表，想将汇总表按客户生成对应的分表，分别发给客户。

q121961393 · 发表于 2018-9-13 09:23

对账单就是最终成型的文件。余额表是现有的文件，表里涂黄的单元格是每次需要更新的数据。
跪求大佬看看能不能解决~~

iwangyi · 发表于 2018-9-13 09:48

本帖最后由 iwangyi 于 2018-9-13 09:50 编辑

For Each sh In Sheets
If sh.Name <> "UFPrn20180908102329" Then sh.Delete
Next
Set cn = CreateObject("adodb.connection")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
Sql = "SELECT distinct 客户名称 from [UFPrn20180908102329$]"
Set rs = cn.Execute(Sql)
Do Until rs.EOF
With Sheets.Add(after:=Sheets(Sheets.Count))
.Name = rs.fields(0) & "对帐明细"
Rows(1).Copy .Rows(1)
Sqll = "select * from [UFPrn20180908102329$] where 客户名称='" & rs.fields(0) & "'"
.Range("a2").CopyFromRecordset cn.Execute(Sqll)
End With
rs.movenext
Loop
End Sub

iwangyi · 发表于 2018-9-13 09:49

附件，请参考

LMY123 · 发表于 2018-9-13 09:50

没看懂A13到E13,E9的数据是怎么得来的？

q121961393 · 发表于 2018-9-13 09:52

补充一下对账单里的四个数按顺序对应余额表里的四个数就行啦

q121961393 · 发表于 2018-9-13 09:57

iwangyi 发表于 2018-9-13 09:49
附件，请参考

功能和想要的有出入，不过还是感谢

q121961393 · 发表于 2018-9-13 09:58

LMY123 发表于 2018-9-13 09:50
没看懂A13到E13,E9的数据是怎么得来的？

对账单里的四个数按顺序对应余额表里的四个数就行啦

zpy2 · 发表于 2018-9-13 11:24

q121961393 发表于 2018-9-13 09:58
对账单里的四个数按顺序对应余额表里的四个数就行啦

这种类似银行年底只对余额的方式如果有差异比较麻烦，最好是类似月度对账单，有明细也有余额。
另外，除非是有纠纷，客户多，打印邮递效率可能比较低。

hzruziniu · 发表于 2018-9-13 12:40

q121961393 发表于 2018-9-13 09:58
对账单里的四个数按顺序对应余额表里的四个数就行啦

Sub 生成分表()
Dim d, k, arr, brr(), sht
Dim i&, r%, MMyr%, n%, j%, m%, b%
Dim shp As Shape
Application.DisplayAlerts = Flase '关闭系统提示
Set d = CreateObject("Scripting.Dictionary")
Set sht = Sheet1
Myr = sht.[a65536].End(xlUp).Row
arr = sht.Range("a2:j" & Myr)
ReDim brr(1 To 500, 1 To 9)
For i = 1 To UBound(arr)
d(arr(i, 4)) = ""
Next
删除分表
For Each k In d.keys
m = m + 1
For i = 1 To UBound(arr)
If arr(i, 4) = k Then
n = n + 1
For j = 1 To 3
brr(n, j) = arr(i, j)
Next
For j2 = 4 To 9
brr(n, j2) = arr(i, j + 1)
Next
End If
Next
Worksheets("模板").Copy after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
.Range("A3:J500").Borders.LineStyle = xlNone
.Range("A3").Resize(n, 9) = brr
.Range("B1") = k
.Name = k
With .Range("A2").Resize(n + 1, 9)
'With Range("a9:h" & 10 + n)
.Borders.LineStyle = xlContinuous '添总体加边框线
.BorderAround xlContinuous, xlMedium '外边框加粗
.Font.Size = 10 '字体10号
End With
End With
n = 0
Next
Sheets("UFPrn20180908102329").Activate
Application.DisplayAlerts = True '系统提示
End Sub
Sub 删除分表()
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name <> "UFPrn20180908102329" And sh.Name <> "模板" Then sh.Delete
Next
Application.DisplayAlerts = True
End Sub

复制代码

hzruziniu · 发表于 2018-9-13 13:23

余额表.rar (82.31 KB, 下载次数: 25)

		自动登录	找回密码
密码			免费注册

[求助] 小白求助。我有一张汇总表，想将汇总表按客户生成对应的分表，分别发给客户。