返回列表 上一主題 發帖

[發問] 請問vba是否可以依指定條件複製出不同excel工作表?

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2016-5-1 11:34 | 顯示全部帖子
本帖最後由 准提部林 於 2016-5-1 11:36 編輯

公式+VBA,
只能產生活頁簿, PDF自行去想辦法,
  1. Sub TEST()
  2. Dim xR As Range, xS As Worksheet, xPH$
  3. xPH = ThisWorkbook.Path & "\"
  4. [總表!2:2].Replace " ", "", LookAt:=xlPart
  5. Application.ScreenUpdating = False
  6. For Each xR In Range([總表!A3], [總表!A65536].End(xlUp))
  7.     If xR.Row < 3 Then Exit Sub
  8.     If xR = "" Or xR(1, 2) = "" Then GoTo 101
  9.     Set xS = Sheets(xR(1, 2) & "")
  10.     xS.[C2] = xR
  11.     xS.[E2] = Format(Date - 7, "mmm.,yyyy")
  12.    
  13.     xS.[C3:C12,E3:E12].FormulaR1C1 = "=VLOOKUP(R2C3,總表!C1:C18,MATCH(TRIM(RC[-1]),總表!R2,),)"
  14.     With xS.[C3:E12]
  15.          .Value = .Value
  16.          .Replace "#N/A", "", LookAt:=xlWhole
  17.          .Replace "0", ""
  18.     End With
  19.    
  20.     xS.Copy
  21.     Application.DisplayAlerts = False
  22.     With ActiveWorkbook
  23.          .Sheets(1).Name = "薪資條"
  24.          .SaveAs xPH & xR & "-" & Format(Date - 7, "yyyymm") & "月薪資條.xls", CreateBackup:=False
  25.          .Close
  26.     End With
  27.     xS.[C3:C12,E3:E12,C2,E2] = ""
  28. 101: Next
  29. End Sub
複製代碼
附檔：
Xl0000004.rar (14.4 KB)
另一載址：
http://www.funp.net/954803　

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2016-5-4 20:14 | 顯示全部帖子
本帖最後由 准提部林 於 2016-5-4 20:16 編輯

回復 7# kathych


〔業務〕工作表，Ｃ２輸入〔甲〕，
Ｃ３：=VLOOKUP($C$2,總表!$A:$R,MATCH(TRIM(B3),總表!$2:$2,),)
公式下拉至Ｃ１２，再貼至Ｅ３：Ｅ１２
這最基本的VLOOKUP函數，應不須多做解釋，
將公式貼成〔值〕，這時公式值有〔數字．０．錯誤值(#N/A)〕三種結果，
以下程式即做加工處理：以〔取代〕方法，清除〔０．錯誤值(#N/A)〕
With xS.[C3:E12]
　　　.Value = .Value
　　　.Replace "#N/A", "", LookAt:=xlWhole
　　　.Replace "0", ""
End With

程式碼的公式：.FormulaR1C1 = "=VLOOKUP(R2C3,總表!C1:C18,MATCH(TRIM(RC[-1]),總表!R2,),)"
是用〔錄製〕取得的，可自行試看看！！！

會用 TRIM(B3) 是因為Ｂ３文字含有〔空白字元〕，必須去除，才能準確抓取對應值，
另．〔總表〕的〔標題列．第二列〕的文字也可能因輸入手誤而含空白字元，
所以程式開頭即以：
[總表!2:2].Replace " ", "", LookAt:=xlPart　做取代，以清除空白字元!

TOP

        靜思自在 : 對父母要知恩，感恩、報恩。
返回列表 上一主題