求助一个能自动生成汇总表的代码

财知道

xiangbaoan 发表于 2018-8-17 11:58
有空行就用原来的；无空行有后来的，它们的区别只有2个字符：
for r= 4 to ubound(ar)  '此句适用于有空 ...

Option Explicit
Sub 导出数据()
Dim d As Object, sh As Worksheet, ar, br(), tp As Range, bm As Range, r&, c%, k&, y&, st$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Worksheets
Next
Application.DisplayAlerts = True
Set d = CreateObject("scripting.dictionary")
With Worksheets("查询表")
    ar = .[a1].CurrentRegion
    Set tp = .[a1].CurrentRegion.Resize(3)
    Set bm = .[a65536].End(3).Resize(1, UBound(ar, 2))
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For r = 4 To UBound(ar) - 1
    st = ""
    For c = 1 To UBound(ar, 2)
        If c <> 11 Then st = st & ar(r, c)
    Next
    If Not d.exists(st) Then
        k = k + 1
        d(st) = k
        For c = 1 To UBound(ar, 2)
            br(k, c) = ar(r, c)
        Next
    Else
        y = d(st)
        br(y, 11) = br(y, 11) + ar(r, 11)
    End If
Next
If k Then
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    With ActiveSheet
        .Name = "导出数据"
        tp.Copy .[a1]
        With .[a4].Resize(k, UBound(br, 2))
            .Value = br
            .Borders.LineStyle = 1
'            .HorizontalAlignment = xlCenter
        End With
        bm.Copy .[a65536].End(3)(2)
        .[e4].Resize(k).NumberFormatLocal = "00"
        .[j4].Resize(k).NumberFormatLocal = "0000"
        .[a:r].EntireColumn.AutoFit
        .DrawingObjects.Delete
    End With
End If
Worksheets("查询表").Activate
Set d = Nothing: Set tp = Nothing: Set bm = Nothing
Application.ScreenUpdating = True
End Sub
求这个代码的解释，本人套用到别处相同记录不会汇总了~~~

xiangbaoan

财知道 发表于 2018-9-11 17:30
Option Explicit
Sub 导出数据()
Dim d As Object, sh As Worksheet, ar, br(), tp As Range, bm As Ra ...

若不介意，加我QQ，私信已发给你了，传上附件，义务帮忙。你也可在此发附件，稍后有空答复，刚才在电脑旁，自斟自饮……谁叫你加了我好友呢。

财知道

xiangbaoan 发表于 2018-9-11 17:44
若不介意，加我QQ，私信已发给你了，传上附件，义务帮忙。你也可在此发附件，稍后有空答复，刚才在电脑旁 ...

不好意思哈，又打扰了，有时间再帮我看看吧，谁让你我是好友呢…………。还有告诉我你QQ号我加你

xiangbaoan

财知道 发表于 2018-9-12 11:08
不好意思哈，又打扰了，有时间再帮我看看吧，谁让你我是好友呢…………。还有告诉我你QQ号我加你

你好！大致看了一下你的语句，要实现你的功能并不难。但要从你的代码去理解你的思路以及你要达到的目的，还得有一个过程。你若不急 且 你的样表能l在一段时间沿用，我是能为你尽量完善的。

财知道

xiangbaoan 发表于 2018-9-12 17:40
你好！大致看了一下你的语句，要实现你的功能并不难。但要从你的代码去理解你的思路以及你要达到的目的， ...

OK，你有空就整下，先谢谢了，很少上网，有事Q我，QQ：532585461.我的代码，公式都可以随便改，只要能达到我的目的。你上前阵给的QQ有误吧，这次给的是向宝安对了吧，我加你了，通过一下

lsc900707

财知道 发表于 2018-9-13 08:17
OK，你有空就整下，先谢谢了，很少上网，有事Q我，QQ：532585461.我的代码，公式都可以随便改，只要能达 ...

人家网名都告诉你大概了，你还怀疑什么呢？