请帮助解决明细分解的问题

抽屉123

各位老师我的问题在附件中已有说明。谢谢！








                          请看附件： 明细分解.zip (8.16 KB, 下载次数: 13)

2018-9-1 21:46 上传

点击文件名下载附件

一把小刀闯天下

'假设明细表A列有序，另外明细表中的城市名工作表都已存在，自己修改

Option Explicit

Sub test()
  Dim arr, i, j, k, m, sum, brr
  arr = Sheets("明细表").[a5].CurrentRegion.Offset(1)
  brr = arr
  For i = 1 To UBound(arr, 1) - 1
    If Len(arr(i, 9)) = 0 Then
      m = m + 1: sum = sum + arr(i, 7)
      For j = 1 To UBound(arr, 2): brr(m, j) = arr(i, j): Next
    End If
    If arr(i + 1, 1) <> arr(i, 1) Then
      For j = 1 To UBound(arr, 1) - 1
        If InStr(arr(j, 9), arr(i, 1)) Then
          m = m + 1: sum = sum + arr(j, 7)
          For k = 1 To UBound(arr, 2): brr(m, k) = arr(j, k): Next
        End If
      Next
      With Sheets(arr(i, 1)).[a5]
        .Resize(Rows.Count - 4, UBound(brr, 2)).ClearContents
        If m > 0 Then
          .Resize(m, UBound(brr, 2)) = brr
          .Cells(m + 2, 1) = "合计"
          .Cells(m + 2, 7) = sum
        End If
      End With
      m = 0: sum = 0
    End If
  Next
End Sub

新时代新征途

一把小刀闯天下 发表于 2018-9-1 22:19
'假设明细表A列有序，另外明细表中的城市名工作表都已存在，自己修改

Option Explicit

老师您好！谢谢帮助。有个想法：
1、能否把“明细表”中有多少城市就自动拆分多少个城市工作表。不需要事先把城市工作表做好。
2、能否可以把城市工作表不用时，进行删除。

lsc900707

用按列拆分的方法，A列不需排序。

opiona

69楼 http://club.excelhome.net/thread-1409141-1-1.html

抽屉123

lsc900707 发表于 2018-9-2 06:33
用按列拆分的方法，A列不需排序。

老师您好！请帮助、帮助。谢谢！

lsc900707

抽屉123 发表于 2018-9-2 09:46
老师您好！请帮助、帮助。谢谢！

1. Private Sub CommandButton1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     For Each sht In Sheets
   
5.         If sht.Name <> ActiveSheet.Name Then sht.Delete
   
6.     Next
   
7.     Application.DisplayAlerts = True
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     arr = [a4].CurrentRegion
   
10.     m = UBound(arr): n = UBound(arr, 2)
    
11.     For i = 2 To m
    
12.         s = arr(i, 1)
    
13.         If Not d.exists(s) Then
    
14.             Set d(s) = Cells(i + 3, 1).Resize(1, n)
    
15.         Else
    
16.             Set d(s) = Union(d(s), Cells(i + 3, 1).Resize(1, n))
    
17.         End If
    
18.      Next
    
19.      x = d.keys
    
20.      For k = 0 To UBound(x)
    
21.          Set sht = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
    
22.          With sht
    
23.              .Name = x(k)
    
24.              d.items()(k).Copy .[a5]
    
25.              Rows("4:4").Copy .[a4]
    
26.              r = .Cells(.Rows.Count, 1).End(3).Row
    
27.              Sum = 0
    
28.              For i = 5 To r
    
29.                 Sum = Sum + Val(.Cells(i, 7))
    
30.              Next
    
31.              .Cells(r + 2, 1) = "合计": .Cells(r + 2, 7) = Sum
    
32.              .UsedRange.Borders.LineStyle = 1
    
33.          End With
    
34.      Next
    
35.      Application.ScreenUpdating = True
    
36.      MsgBox "拆分完成!"
    
37. End Sub

复制代码

lsc900707

抽屉123 发表于 2018-9-2 09:46
老师您好！请帮助、帮助。谢谢！

代码需要审核，附件供参考：

抽屉123

lsc900707 发表于 2018-9-2 10:17
代码需要审核，附件供参考：

老师您好！谢谢您的帮助。有一点需要说明的也是重要的：

  1、在“明细表”“来源”I列中，如果有城市名与A列中“城市名”相同的，在城市分解时归为相同的城市里。

2、这是拆分前的“明细表”

城市名	日期	信息1	主要日期	日期1	信息2	金额	信息4	来源
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝	上海转入
上海	2018-2-15	5555	2018-2-20	2018-2-28	6	7777	淘宝
上海	2018-2-15	5555	2018-2-23	2018-2-28	6	7777	淘宝
上海	2018-2-15	5555	2018-2-23	2018-2-28	6	7777	淘宝	天津转入
天津	2018-2-8	147	2018-2-10	2018-2-14	2	123	淘宝
天津	2018-2-8	147	2018-2-10	2018-2-14	2	123	淘宝
天津	2018-2-8	147	2018-2-10	2018-2-14	2	123	淘宝	南京转入

这是拆分后的南京的城市工作表

城市名	日期	信息1	主要日期	日期1	信息2	金额	信息4	来源	信息6
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝		2
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝		2
南京	2018-2-1	147	2018-2-1	2018-2-3	2	123	淘宝		2
天津	2018-2-8	147	2018-2-10	2018-2-14	2	123	淘宝	南京转入	2

请看上面两表字体为红紫色的内容。“来源”列的“南京转入”字样拆分后应该归到南京的工作里。其他工作表与此相同。

lsc900707

抽屉123 发表于 2018-9-2 11:52
老师您好！谢谢您的帮助。有一点需要说明的也是重要的：

  1、在“明细表”“来源”I列中，如果有城市 ...

喔，这个要求倒是有点意思，有时间我修改一下。