求助，用VBA根据表一客户名称生成各分表内容，谢谢大家

958888

用VBA根据表一客户名称生成各分表内容，谢谢大家

quqiyuan

参与一下，这是我的想法，可能跟楼主的有出入，但是楼主的想法不是很明确，只能供参考啦。。。

quqiyuan

代码如下。。。
Sub test()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    arr = Sheet1.UsedRange
    For i = Sheets.Count To 2 Step -1   '保留第一个工作表，看实际需要
        Sheets(i).Delete
    Next
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 2)
        If Not d.exists(s) Then
            d(s) = i
        Else
            d(s) = d(s) & "|" & i
        End If
    Next
    For Each k In d.keys
        s = Split(d(k), "|")
        ReDim brr(1 To UBound(s) + 1, 1 To UBound(arr, 2))
        For i = 0 To UBound(s)
            For j = 1 To UBound(arr, 2)
                brr(i + 1, j) = arr(s(i), j)
            Next
        Next
        With Sheets.Add(after:=Sheets(Sheets.Count))
            .[a1].Resize(, UBound(arr, 2)) = arr
            .[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
            .Name = k
        End With
    Next
    Set d = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Beep
End Sub

3190496160

楼主目前模拟的分表数据，实在让人费解，比如，张三，这个分表里面为什么还会有其他人的数据呢？还有，分表中第二行是合计，后面的几列，都是数值，都要合计？？？？

taller

1. Option Explicit
   
2. Sub Demo()
   
3.     Dim objDic As Object, rngData As Range
   
4.     Dim i As Long, sKey
   
5.     Dim arrData
   
6.     Set objDic = CreateObject("scripting.dictionary")
   
7.     Dim oSht As Worksheet
   
8.     Set oSht = Sheets("Sheet1")
   
9.     Dim oSht1 As Worksheet
   
10.     Set rngData = oSht.Range("A1").CurrentRegion
    
11.     arrData = rngData.Value
    
12.     For i = LBound(arrData) + 1 To UBound(arrData)
    
13.         sKey = arrData(i, 2)
    
14.         objDic(sKey) = ""
    
15.     Next i
    
16.     rngData.AutoFilter
    
17.     For Each sKey In objDic.keys
    
18.         rngData.AutoFilter Field:=2, Criteria1:=sKey
    
19.         Set oSht1 = Nothing
    
20.         On Error Resume Next
    
21.         Set oSht1 = Sheets(sKey)
    
22.         On Error GoTo 0
    
23.         If oSht1 Is Nothing Then
    
24.             Set oSht1 = Sheets.Add(After:=Sheets(Sheets.Count))
    
25.             oSht1.Name = sKey
    
26.         Else
    
27.             oSht1.Cells.Clear
    
28.         End If
    
29.         With oSht1
    
30.             rngData.Copy .Range("A1")
    
31.             i = .Cells(.Rows.Count, 1).End(xlUp).Row
    
32.             If i > 1 Then
    
33.                 .Rows(2).Insert
    
34.                 .Range("A2").Value = "合计"
    
35.                 .Range("C2").Resize(1, UBound(arrData, 2) - 2).FormulaR1C1 = "=SUM(R[1]C:R[" & i - 1 & "]C)"
    
36.             End If
    
37.         End With
    
38.     Next
    
39.     rngData.AutoFilter
    
40. End Sub
    
41. 
    

复制代码

taller