- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
58#
發表於 2014-2-18 15:25
| 只看該作者
回復 57# iceandy6150 - Option Explicit
- Sub Ex()
- Dim xlMon As Integer, xlYear As String, A As Variant, E As Variant, Ay As String
- Dim Rng(1 To 2) As Range, Rng_Ar(), Ar(), i As Integer, Sh As Variant, X As Integer
- ReDim Ar(1 To Sheets.Count) '陣列:元素數 = Sheets.Count
- For i = 1 To Sheets.Count
- Ar(i) = Sheets(i).Name '陣列:元素導入 Sheets.Name
- Next
- With Sheets("損益表")
- xlYear = Mid(.[a3], InStrRev(.[a3], "至") + 1, InStrRev(.[a3], "年") - InStrRev(.[a3], "至"))
- 'xlYear : 損益表的年度
- xlMon = Mid(.[a3], InStrRev(.[a3], "年") + 1, InStrRev(.[a3], "月") - InStrRev(.[a3], "年") - 1)
- 'xlMon : 損益表的月份
- Set Rng(1) = .[A6,A8,A9,A11,A18:A32,A35:A37]
- ''6個範圍: 銷貨收入,進貨,期末存貨,減：期末存貨,支出,收入 ****
- End With
- For Each A In Rng(1).Areas 'Areas 屬性 傳回 Areas 集合，此集合代表多重範圍中的所有範圍。唯讀
- If InStr(A.Cells(1), "存貨") Then Ay = "存貨" Else Ay = ""
- '例外設定: 期初存貨,期末存貨,的工作表是"存貨??_??"
- ReDim Rng_Ar(1 To A.Count) '陣列:元素數 = 費用項目數
- For i = 1 To A.Count
- Sh = Filter(Ar, IIf(Ay = "", Trim(A.Cells(i)), Ay), True)
- If A.Cells(i) = "" Then Sh = Array() '防呆
- 'Filter 函數 傳回一個從零開始的陣列，該陣列包含基於指定篩選準則的一個字串陣列的子集。
- For Each E In Sh
- With Sheets(E) '有"費用項目"名稱的 工作表
- Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows) '核對年度
- If Not Rng(2) Is Nothing Then Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole) '搜尋月份
- If Not Rng(2) Is Nothing Then
- X = 1
- Do
- If Rng(2).Offset(X).Row > .Cells(.Rows.Count, "D").End(xlUp).Row Then Exit Do
- If Rng(2).Offset(X) <> Rng(2) And Rng(2).Offset(X) <> "" Then Exit Do
- X = X + 1
- Loop
- 'Rng(2).Resize(X, 9) : 月份的範圍
- If InStr(E, "收入") Then
- Set Rng(2) = Rng(2).Resize(X, 9).Find("本月合計", lookat:=xlPart) '搜尋本月合計
- If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("D1")
- '貸 方 'Range("D1")金額位置:本月合計的第4欄
- Else
- If Trim(A.Cells(i)) = "減：期末存貨" Then
- With Rng(2).Resize(X, 9)
- Rng_Ar(i) = Rng_Ar(i) + .Cells(.Rows.Count, 6)
- '借方:當月份<存貨5-6>的F欄的.End(xlDown) :"最後一格 "
- End With
- Else
- Set Rng(2) = Rng(2).Resize(X, 9).Find("本月合計", lookat:=xlPart) '搜尋本月合計
- If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("C1")
- '借方 'Range("C1")金額位置:本月合計的第3欄
- End If
- End If
- End If
-
- End With
- Next
- Next
- A.Offset(, IIf(Trim(A.Cells(1)) = "銷貨收入", 2, 1)) = Application.WorksheetFunction.Transpose(Rng_Ar)
- 'Transpose(轉置) : 一維陣列(橫式) 轉換為 二維陣列(這裡變一列直式)
- Next
- End Sub
|
|
發表於 2014-2-13 23:24
| 
