返回列表 上一主題 發帖

多sheet報表整理問題

本帖最後由 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的名稱, 如【非正職員工薪資】等前後均不能有空白
如下圖:

測試結果如下:
  1. Option Explicit
  2. Option Base 1
  3. Private Sub 彙整Button_Click()
  4.     Dim Sh, newSh As Object
  5.     Dim i, j, shcnt As Integer
  6.     Dim findStr
  7.     Dim findC As Range
  8.    
  9.     Set newSh = ThisWorkbook.Sheets("新的sheet")
  10.     findStr = Array("非正職員工薪資", "正職員工薪資", "c", "d")
  11.    
  12.     shcnt = ThisWorkbook.Sheets.Count
  13.     For j = 1 To shcnt - 1
  14.         Set Sh = Sheets(j)
  15.         If Sh.Name <> "新的sheet" Then
  16.             For i = 1 To 4
  17.                 Set findC = Sh.Columns(1).Find( _
  18.                     What:=findStr(i), _
  19.                     After:=Sh.[A1], _
  20.                     LookIn:=xlValues, _
  21.                     LookAt:=xlWhole)
  22.                 If Not findC Is Nothing Then
  23.                     newSh.Cells(i + 1, j + 1).Value = findC.Offset(0, 2)
  24.                 End If
  25.             Next
  26.         End If
  27.     Next
  28. 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

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題