[算表] VBA將資料依欄位新增於特定工作簿/工作表

看板Office作者cyserica (艾莉卡)時間10年前 (2015/11/18 11:39)推噓0(0推 0噓 5→)

留言5則, 1人參與討論串1/1

軟體: Office 版本: 2007 最近才剛接觸EXCEL VBA這個領域，所以使用上還很初階又生疏但剛好工作上遇到一個專案需要透過VBA來做才會比較有效率問題描述：公司業務每日需寫業務行程日誌，檔案格式固定如下日期業務名產業客戶廠別模組 Team ---------------------------------------------------------------- 2015/11/3 Amy 半導體台積電 12廠蝕刻 POLY 2015/11/3 Ray LCD 友達龍潭濕蝕刻 ─ 希望透過VBA做到以資料自動分類去特定檔案而檔案的規則如下客戶+廠別做為工作簿檔名工作簿內的工作表則是以模組+Team命名依據每一列的資料欄位去寫入該工作簿工作表若該工作簿的名稱不存在，則新增一個以"客戶+廠別"為檔名的工作簿(如.台積電12廠) 若該工作簿裡不存在那個"模組+Team"的工作表(如.蝕刻POLY) 則新增一個以"模組+Team"為檔名的工作表原始要分類的檔案如下 https://goo.gl/nfyXLa 目前初步撰寫的VBA程式碼如下問題 1.在新增工作簿時遇到困難 2.檔案命名不知道是否可以兩個值結合命名 --------------------------------------------------------------------------- Sub wrkbkadd1() '本段有困難，不知如何新增特定名稱的工作簿，目前只是照樣造句仿新增工作表而已 Dim k As Integer, wrk As Workbook k = 2 Set wrk = Workbooks("業務日誌") Do While wrk.Worksheets.Cells(k, "D").Value <> "" On Error Resume Next If Workbooks(wrk.Worksheets.Cells(k, "D").Value) Is Nothing Then ActiveWorkbook.Worksheets.Add With Workbook.Name = wrk.Worksheets.Cells(k, "D").Value End With End If ActiveWorkbook.Close savechanges:=True Loop End Sub ------------------------------------------------------------------------ Sub shtadd1() '依據模組的欄位新增分頁，並且自動分類至該分頁 Dim i As Integer, sht As Worksheet i = 2 Set sht = Worksheets("業務日誌") Do While sht.Cells(i, "F").Value <> "" On Error Resume Next If Worksheets(sht.Cells(i, "F").Value) Is Nothing Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = sht.Cells(i, "F").Value End If i = i + 1 Loop End Sub --------------------------------------------------------------------------- Sub feilei到分頁() '把模組和TEAM分到各個工作表中 Dim i As Long, bj As String, rng As Range i = 2 bj = Cells(i, "F").Value Do While bj <> "" Set rng = Worksheets(bj).Range("A65536").End(xlUp).Offset(1, 0) Cells(i, "A").Resize(1, 12).Copy rng i = i + 1 bj = Cells(i, "F").Value Loop End Sub ---------------------------------------------------------------------------- 希望我有把問題陳述清楚請版上的高手們指點一二謝謝各位 -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 114.32.244.227 ※ 文章網址: https://www.ptt.cc/bbs/Office/M.1447817984.A.467.html ※ 編輯: cyserica (114.32.244.227), 11/18/2015 11:41:13