- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
6#
發表於 2014-2-28 12:21
| 只看該作者
本帖最後由 yen956 於 2014-2-28 12:24 編輯
回復 5# ippo380
本VBA code 在下列條件下, 才能正常運作
1. "新的sheet" 標題列的 名稱, 如 3月、4月、5月等的順序 應與 工作表 的 名稱順序 一致
2, "新的sheet" 欄A的名稱, 如【非正職員工薪資】、【非正職員工薪資】等的順序,
應與 VBA 中
findStr = Array("非正職員工薪資", "正職員工薪資", "c", "d")
的 順序 一致
3. "新的sheet" 欄A的名稱, 如【非正職員工薪資】等前後均不能有空白
如下圖:

測試結果如下:
 - Option Explicit
- Option Base 1
- Private Sub 彙整Button_Click()
- Dim Sh, newSh As Object
- Dim i, j, shcnt As Integer
- Dim findStr
- Dim findC As Range
-
- Set newSh = ThisWorkbook.Sheets("新的sheet")
- findStr = Array("非正職員工薪資", "正職員工薪資", "c", "d")
-
- shcnt = ThisWorkbook.Sheets.Count
- For j = 1 To shcnt - 1
- Set Sh = Sheets(j)
- If Sh.Name <> "新的sheet" Then
- For i = 1 To 4
- Set findC = Sh.Columns(1).Find( _
- What:=findStr(i), _
- After:=Sh.[A1], _
- LookIn:=xlValues, _
- LookAt:=xlWhole)
- If Not findC Is Nothing Then
- newSh.Cells(i + 1, j + 1).Value = findC.Offset(0, 2)
- End If
- Next
- End If
- Next
- End Sub
複製代碼 多報表整理.7z
http://www.mediafire.com/download/2vwo28i7wvd59dh/%E5%A4%9A%E5%A0%B1%E8%A1%A8%E6%95%B4%E7%90%86.7z |
|