[已解决]请教如何实现图片上的效果，恳请大师帮忙！

80013025

数据合并显示.rar (16.87 KB, 下载次数: 19)

2011-11-1 09:21 上传

点击文件名下载附件


Sub 汇总()
    Dim Wk As Workbook, myPath$, MyName$, i&
    Application.ScreenUpdating = False
    Range("B3:G" & Range("F65536").End(3).Row + 1).ClearContents
    myPath = ThisWorkbook.Path & "\退货数据DATA\"
    MyName = Dir(myPath & "*.xls")
    Do While MyName <> ""
        Set Wk = Workbooks.Open(myPath & "\" & MyName)
        ARR = Wk.Sheets(1).Range("B3:G" & Wk.Sheets(1).Range("B65536").End(3).Row)
        ThisWorkbook.Sheets(1).Range("B65536").End(3)(2).Resize(UBound(ARR), 6) = ARR
        Wk.Close False
        MyName = Dir
    Loop
    W = Range("G65536").End(3).Row
    For i = 3 To W
        Range("G" & i) = Replace(Range("G" & i), ",", "")
        Range("G" & i) = Val(Right(Range("G" & i), Len(Range("G" & i)) - 1))
    Next
    Columns("F:F").NumberFormatLocal = "#,##0.00"
    Columns("G:G").NumberFormatLocal = "￥#,##0.00"
    Range("F65536").End(3)(3) = "合 计"
    Range("G65536").End(3)(3).FormulaR1C1 = "=SUM(R[-" & W + 1 & "]C:R[-2]C)"
    Application.ScreenUpdating = True
    MsgBox "汇总完毕"
    ActiveWindow.SmallScroll Down:=-65535
End Sub

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2011-11-1 10:47

请见附件。

跳转到最佳答案楼层

蓝桥玄霜

1. Sub 汇总()
   
2.     Dim Wk As Workbook, myPath$, MyName$, i&
   
3.     Dim Sht As Worksheet, col&, j&
   
4.     Application.ScreenUpdating = False
   
5.     Set Sht = ActiveSheet
   
6.     Range("m6:r47", "t6:y47").ClearContents
   
7.     myPath = ThisWorkbook.Path & "\退货数据DATA"
   
8.     MyName = Dir(myPath & "*.xls"): i = 6: col = 13
   
9.     Do While MyName <> ""
   
10.         Set Wk = Workbooks.Open(myPath & "" & MyName)
    
11.         arr = Wk.Sheets(1).Range("B3:G" & Wk.Sheets(1).Range("B65536").End(3).Row)
    
12.         j = 0
    
13.         Do
    
14.             j = j + 1
    
15.             If i > 47 Then
    
16.                 col = col + 7: i = 6
    
17.                 If col > 20 Then MsgBox "数据溢出无法显示汇总全部内容。": Exit Sub
    
18.             End If
    
19.             If j <= UBound(arr) Then
    
20.                 Sht.Cells(i, col).Resize(1, 6) = Application.Index(arr, j, 0): i = i + 1
    
21.             Else
    
22.                 Exit Do
    
23.             End If
    
24.         Loop While col < 21
    
25.         Wk.Close False
    
26.         MyName = Dir
    
27.     Loop
    
28.     Columns("q:q").NumberFormatLocal = "#,##0.00"
    
29.     Columns("x:x").NumberFormatLocal = "#,##0.00"
    
30.     Columns("r:r").NumberFormatLocal = "￥#,##0.00"
    
31.     Columns("y:y").NumberFormatLocal = "￥#,##0.00"
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "汇总完毕"
    
34. End Sub
    
35. 
    

复制代码

蓝桥玄霜

请见附件。

80013025

回复 蓝桥玄霜 的帖子

老师能否帮忙把Q、R、X、Y汇总后显示的数值改成 数字格式，文本格式无法使用SUM求和

蓝桥玄霜

把后面两句删除即可。
    'Columns("r:r").NumberFormatLocal = "￥#,##0.00"
    'Columns("y:y").NumberFormatLocal = "￥#,##0.00"