[已解决]合并数据

张雄友

合并数据问题。

最佳答案

月排行榜 / 总排行榜

grf1973

2015-3-27 09:32

你的数据样式一直在变，折腾死了。干脆行、列合计都计算所得，不去表里直接调用了。

跳转到最佳答案楼层

lmze2000

你的主代码修改成下面的：你试一下看看。

1. Sub 合并各单位销售费用()
   
2.     Dim MyPath As String, FileName As String, wb As Workbook, Columncount As Long, Sh As Worksheet, Zsht As Worksheet
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .InitialFileName = ThisWorkbook.Path & ""
   
5.         If .Show = False Then Exit Sub
   
6.         MyPath = .SelectedItems(1) & ""
   
7.     End With
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     Set w = Application.WorksheetFunction
   
10.     Set Zsht = Sheets("get")
    
11.     FilePath = GetName(MyPath)
    
12.       For kk = 0 To UBound(FilePath)
    
13.           Set wb = Workbooks.Open(FilePath(kk))
    
14.           Set Sh = wb.Sheets(1)
    
15.                 Sh.Range("c7:c31").Copy Zsht.[a7].Offset(, Zsht.Cells(7, Zsht.Columns.Count).End(1).Column)
    
16.                     Columncount = Columncount + 1
    
17.                     Zsht.Cells(4, Columncount + 2).Value = Split(wb.Name, ".")(0)
    
18.             wb.Close False
    
19.         Next
    
20.     Set wb = Nothing
    
21.     Cells(4, Columncount + 3) = "合计"
    
22.     Cells(7, Columncount + 3).Resize(25) = SumByRows(Columncount)
    
23.     Call MergeRange
    
24. End Sub

复制代码

张雄友

lmze2000 发表于 2015-3-23 08:31
你的主代码修改成下面的：你试一下看看。

又花了几个小时，越生越多，连续执行10次，不断增多。

lmze2000

张雄友 发表于 2015-3-23 18:40
又花了几个小时，越生越多，连续执行10次，不断增多。

那是你没有清空原数据区域，所以你每点一次，都会在后面的区域写入数据，
你把Range("c4:aa31").ClearContents这条语句加在前面，你看一下。

张雄友

lmze2000 发表于 2015-3-23 19:35
那是你没有清空原数据区域，所以你每点一次，都会在后面的区域写入数据，
你把Range("c4:aa31").ClearCo ...

应该是  End(1)  用得死板。

张雄友

lmze2000 发表于 2015-3-23 19:35
那是你没有清空原数据区域，所以你每点一次，都会在后面的区域写入数据，
你把Range("c4:aa31").ClearCo ...

B列标题不一样就不能用复制了.

zjdh

略作修改
合并数据.rar (30.67 KB, 下载次数: 6)

2015-3-23 20:54 上传

点击文件名下载附件

张雄友

zjdh 发表于 2015-3-23 20:54
略作修改

能不能根据 B 列不重复项目生成？根据B列不重复项目全部生成，如果以后多了一个项目不就落空了。

grf1973

1. Sub test()
   
2.     Dim Wb As Workbook, Sh As Worksheet
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set ff = fso.getfolder(ThisWorkbook.Path)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For Each fff In ff.subfolders       '读入数据
   
7.        For Each F In fff.Files
   
8.          Set Wb = Workbooks.Open(F)
   
9.          Set Sh = Wb.Worksheets(1)
   
10.          arr = Sh.[a1].CurrentRegion
    
11.          frr = Split(F, "")
    
12.          yf = Split(frr(UBound(frr)), ".")(0)      '取得月份数
    
13.          For i = 7 To UBound(arr)
    
14.             x = yf & arr(i, 2)         '月份+项目为key
    
15.             d(x) = arr(i, 3)
    
16.         Next
    
17.         Wb.Close False
    
18.        Next
    
19.     Next
    
20.     With ActiveSheet
    
21.         .[c7].Resize(100, 100).ClearContents
    
22.         arr = .[a1].CurrentRegion
    
23.         For i = 7 To UBound(arr)
    
24.             s = 0
    
25.             For j = 3 To UBound(arr, 2) - 1
    
26.                 x = arr(4, j) & arr(i, 2)
    
27.                 arr(i, j) = d(x)
    
28.                 s = s + Val(arr(i, j))
    
29.             Next
    
30.             arr(i, j) = s  '最后一列合计
    
31.         Next
    
32.         .[a1].CurrentRegion = arr
    
33.     End With
    
34. End Sub
    

复制代码

张雄友

grf1973 发表于 2015-3-24 11:37

怎么没有数据出来？