- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2013-7-8 06:41
| 只看該作者
回復 3# adam2010 - Option Explicit
- Sub Ex()
- Dim Rng(1 To 2) As Range, M As String, R As Integer
- With ActiveSheet
- Set Rng(1) = .Range("A2") '物件: A2儲存格
- R = .[A1].End(xlToRight).Column '數值: A1往右到最後有數值的欄號
- Do
- If InStrRev(Rng(1), "X") <> Len(Rng(1)) And M = "" Then '儲存格右邊第一個字串<>"X" 且 M = ""
- M = Mid(Rng(1), 1, Len(Rng(1)) - 1) 'M = 去掉儲存格右邊第一個字串的字串
- Set Rng(2) = Rng(1) '物件 Rng(2) :第1 個子檔位置
- ElseIf InStrRev(Rng(1), "X") = Len(Rng(1)) Then '是母檔
- Rng(1).Resize(1, R).Interior.Color = vbGreen '***加入底色
- M = "" '是母檔 : M=""
- ElseIf M <> "" And M <> Mid(Rng(1), 1, Len(Rng(1)) - 1) Then '讀完相同的子檔
- Rng(1).EntireRow.Insert '使用插入方法,Rng(1)會下移
- Set Rng(1) = Rng(1).Offset(-1) '母檔的位置
- Set Rng(2) = Range(Rng(1).Offset(-1), Rng(2)) '所有子檔的範圍
- With Rng(1)
- .Resize(1, R).Interior.Color = vbGreen '***加入底色
- .Cells = M & "X"
- .Cells(1, "H").Resize(1, R - 8) = "=SUM(R[-1]C:R[-" & Rng(2).Rows.Count & "]C)"
- ' R - 8 : H欗到 A1往右到最後有數值的欄號 - 1欗
- .Cells(1, "H").Resize(1, R - 8) = .Cells(1, "H").Resize(1, R - 8).Value
- .Cells(1, R) = Application.Sum(.Cells(1, 8).Resize(1, R - 8))
- .Cells(1, "D") = Application.Sum(Rng(2).Range("D1:F" & Rng(2).Rows.Count))
- .Cells(1, "G") = .Cells(1, "D") - .Cells(1, R)
- End With
- M = ""
- End If
- Set Rng(1) = Rng(1).Offset(1) '物件 Rng(1)移往下一列
- Loop Until Rng(1) = ""
- End With
- End Sub
|
|
發表於 2013-7-6 17:40
| 
