- 帖子
- 472
- 主題
- 5
- 精華
- 0
- 積分
- 485
- 點名
- 0
- 作業系統
- Windows
- 軟體版本
- MS Office
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 香港
- 註冊時間
- 2010-7-4
- 最後登錄
- 2014-12-28
|
本帖最後由 kimbal 於 2010-8-3 22:06 編輯
把分頁資料合併到主頁的方法
單純把欄抄出,不做彙總.
彙總的話, 請先了解內建"樞紐表"和"合併彙總"用法
欄位位置不拘,但A欄為主鍵(可手工調節),
分頁可以不放欄位.
如果欄名跟主頁不一致,可在主頁欄位註解上填上,用豆號分隔
除主鍵外其他欄內容可以為空.
歡迎留意見/討論- Option Explicit
-
- Public Sub refresh_all()
- Dim shtCurr As Worksheet
- Dim rngHeader As Range, rngResult As Range, strHeaderArray, strHeader
- Dim lngLastPosition As Long
- With ActiveSheet
- .[A1].CurrentRegion.Offset(1).Clear
- lngLastPosition = 2
- For Each shtCurr In Sheets
- If shtCurr.Name <> .Name Then
- For Each rngHeader In .[A1].CurrentRegion.Rows(1).Cells
- If (rngHeader.Comment Is Nothing) Then
- strHeaderArray = Split(rngHeader.Value)
- Else
- strHeaderArray = Split(rngHeader.Comment.Text & "," & rngHeader.Value, ",")
- End If
- For Each strHeader In strHeaderArray
- Set rngResult = shtCurr.Rows(1).Find(strHeader, LookIn:=xlValues, LookAt:=xlWhole)
- If Not rngResult Is Nothing Then
- shtCurr.Range(rngResult.Offset(1), _
- rngResult.Offset(rngResult.CurrentRegion.SpecialCells(xlCellTypeLastCell).Row - 1)).Copy Destination:= _
- .Cells(lngLastPosition, rngHeader.Column)
- Exit For
- End If
- Next
- Next
- lngLastPosition = .Cells(Rows.Count, 1).End(xlUp).Row + 1
- End If
- Next
- End With
- End Sub
|
|
發表於 2010-8-2 00:36
| 
