- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 3# Hero2013
試試看- Option Explicit
- Sub Ex()
- Dim Ar(), Ay(), Rng As Range, i As Integer, R As Integer
- With Sheets("print")
- For i = .Range("G9").Value To .Range("H9").Value
- With Sheets("Journal")
- Set Rng = .Range("A5", .Range("A5").End(xlDown)).Find(i, LOOKAT:=xlWhole)
- End With
- If Not Rng Is Nothing Then
- Do While Rng = i
- R = R + 1
- With Rng
- ReDim Preserve Ar(1 To R)
- Ar(R) = Array(.Range("B1").Value, .Range("C1").Value, .Range("G1").Value, .Range("H1").Value, .Range("I1").Value)
- End With
- Set Rng = Rng.Offset(1)
- Loop
- Ay = Application.Transpose(Ar)
- R = R + 1
- ReDim Preserve Ar(1 To R)
- Ar(R) = Array("", "", "總 數:", Application.Sum(Application.Index(Ay, 4)), Application.Sum(Application.Index(Ay, 5)))
- 'Dr借項 Application.Index(Ay, 4)
- 'Cr貸項 Application.Index(Ay, 5)
- Ar = Application.Transpose(Application.Transpose(Ar))
- .[a10:e10].Resize(R).Value = Ar
- .PageSetup.PrintArea = "A3:" & .[a10:e10].Resize(R).Address '設定印列範圍
- .PrintOut '印列
- Erase Ar '重新初始化固定大小陣列的元素,並釋放動態陣列的儲存空間
- .[a10:e10].Resize(R) = ""
- R = 0
- End If
- Next
- End With
- End Sub
複製代碼 |
|