GBKEE

回復 1# b9208
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, xRow As Integer, xi As Integer
   
4.     Set Rng = Sheets("地點").[A4]
   
5.     With Sheets("統計")
   
6.         .Range("a4", .Range("q4").End(xlDown)).Clear
   
7.         xRow = 4
   
8.         Do While Rng.MergeCells
   
9.             .Cells(xRow, "A") = Rng
   
10.             .Cells(xRow, "J") = Rng
    
11.              .Cells(xRow, "B") = Rng.Cells(1, 2).Text
    
12.              .Cells(xRow, "k") = Rng.Cells(1, 2).Text
    
13.              .Cells(xRow, "C") = Rng.Cells(7, 2).Text
    
14.              .Cells(xRow, "L") = Rng.Cells(7, 2).Text
    
15.              For xi = 4 To 8
    
16.              With Rng.Offset(, xi - 1).Resize(7)
    
17.                 Sheets("統計").Cells(xRow, xi) = Application.Sum(.Value)
    
18.                 Sheets("統計").Cells(xRow, xi + 9) = Application.CountIf(.Cells, ">0")
    
19.                 End With
    
20.              Next
    
21.              xRow = xRow + 1
    
22.             Set Rng = Rng.End(xlDown)
    
23.         Loop
    
24.         .Range("a4:" & .Range("H4").End(xlDown).Address & ", J4:" & Range("q4").End(xlDown).Address).Borders.Value = 1
    
25.     End With
    
26. End Sub

複製代碼