- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
15#
發表於 2014-2-2 09:43
| 只看該作者
本帖最後由 GBKEE 於 2014-2-2 09:45 編輯
回復 14# b7307024
擺放資料工作表模組的程式碼- Option Explicit '在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
- Option Base 1 '在模組層次中用來宣告陣列索引的預設下限->為 1
- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Address = "$B$1" Then
- Ext_data Target
- End If
- End Sub
- Private Sub Ext_data(ByVal Target As Range)
- Dim mnth As Worksheet, all_month(), Rng As Range, AR(), R As Range, S As Integer
- S = 1
- Application.ScreenUpdating = False
- Set Rng = Target.Parent.Range("A5")
- Rng.CurrentRegion.Offset(1).Clear
- all_month = Array("Jan", "Feb", "Mar")
- For Each mnth In Sheets(all_month)
- With mnth
- .Range("A1").AutoFilter 4, "*" & Target & "*" '自動篩選
- For Each R In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
- If R.Row > 1 Then
- ReDim Preserve AR(1 To S)
- 'AR(S) = R '整列
- AR(S) = Array(R.Cells(1).Value, R.Cells(4).Value) '日期,細節
- S = S + 1
- End If
- Next
- .AutoFilterMode = False
- End With
- Next
- Rng.Offset(1).Resize(S - 1, UBound(AR(1))) = Application.Transpose(Application.Transpose(AR))
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2013-7-4 21:18
| 
