麻辣家族討論版版 - Powered by Discuz! Board

標題: EXCEL表單自動生成表單或者WORD檔案 [打印本頁]

作者: m06o2 時間: 2023-9-19 17:54 標題: EXCEL表單自動生成表單或者WORD檔案

從N欄篩選單位，製作當月的報表如下面word檔案，由下圖1 N欄進行篩選，結果如圖2，然後製作成圖3。
目前我是用篩選的看有幾個單位每個單位製作成一張表單，有沒有辦法用VBA自動生成各單位的表單。

[attach]36833[/attach]
[attach]36834[/attach]
[attach]36835[/attach]

[attach]36836[/attach]

作者: Andy2483 時間: 2023-9-21 08:50

回復 1# m06o2

謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
[attach]36837[/attach]

資料表:
[attach]36838[/attach]

結果表:
[attach]36839[/attach]

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr(1 To 16, 1 To 12), Brr, Crr, V, D, E, Z, Q, i&, j%, R&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([總表!A4], [總表!O65536].End(3))
For i = 1 To UBound(Brr)
If Trim(Brr(i, 7)) <> "" And Brr(i, 15) = "" Then MsgBox "資料不完整": Exit Sub
If Val(Brr(i, 15)) > 0 Then
   For j = 1 To 9
      If Trim(Brr(i, j)) = "" Then MsgBox "資料不完整": Exit Sub
   Next
End If
Next
D = Array(1, 2, 3, 7, 11, 12)
E = Split("2,4,6,8,9,15", ",")
For i = 1 To UBound(Brr)
V = Z(Brr(i, 7))
If Not IsArray(V) Then V = Arr
R = Z(Brr(i, 7) & "|R") + 1: Z(Brr(i, 7) & "|R") = R
For j = 0 To UBound(D): V(R, D(j)) = Brr(i, E(j)): Next
Z(Brr(i, 7)) = V
Next
Crr = Range([輔助表!C1], [輔助表!A65536].End(3))
For i = 1 To UBound(Crr): Z(Crr(i, 1) & "|") = i: Next
For i = Sheets.Count To 1 Step -1
If InStr(Sheets(i).Name, ".") Then Sheets(i).Delete
Next
For Each Q In Z.KEYS
If Not IsArray(Z(Q)) Then GoTo Q01
With Sheets("列印").Copy(after:=Worksheets(Sheets.Count))
   R = Z(Q & "|R"): ActiveSheet.Name = Q & "."
   [B3] = Q: [B4] = Crr(Z(Q & "|"), 2): [B5] = Crr(Z(Q & "|"), 3)
   With [A9].Resize(R, 12)
      .Value = Z(Q): .Borders.LineStyle = 1
      .Item(.Count + 11) = "總計:": .Item(.Count + 11).Font.Bold = True
      .Item(.Count + 12) = "=SUM(L9:L" & 8 + R & ")"
      .Item(.Count + 12).Font.Bold = True
      With Range(.Item(.Count + 25), [L27])
         .Merge: .Value = "備註:"
         .HorizontalAlignment = xlLeft
         .VerticalAlignment = xlTop
         .Borders.LineStyle = 1
      End With
   End With
End With
Q01: Next
Set Z = Nothing: Erase Arr, Brr, Crr
End Sub

作者: m06o2 時間: 2023-9-22 09:18

回復 2# Andy2483

正在研究前輩的程式碼中!!

作者: m06o2 時間: 2023-9-22 10:02

回復 2# Andy2483

剛剛測試把單位名稱改成DDD 發現程式就會出現錯誤

[B3] = Q: [B4] = Crr(Z(Q & "|"), 2): [B5] = Crr(Z(Q & "|"), 3)

作者: Andy2483 時間: 2023-9-22 13:23

回復 4# m06o2
輔助表需要先建DDD的基本資料

作者: m06o2 時間: 2023-9-22 13:26

回復 5# Andy2483

懂了!!我立刻去試試看

作者: m06o2 時間: 2023-9-22 13:56

回復 6# m06o2

目前感覺他是搜尋總表的G欄進行排列，我想要他用N欄進行排列，但找不到地方可以改

作者: Andy2483 時間: 2023-9-22 14:23

回復 7# m06o2

G欄與 N欄資料是相同的
什麼原因會出現不一樣？

作者: m06o2 時間: 2023-9-22 15:41

回復 8# Andy2483

要搜尋N欄才可以當初我是想說簡單化讓他一樣~但是正常是用N欄做表單通常都不一樣

作者: m06o2 時間: 2023-9-22 16:55

回復 9# m06o2
我找到了~感謝!

V = Z(Brr(i, 14))
If Not IsArray(V) Then V = Arr
R = Z(Brr(i, 14) & "|R") + 1: Z(Brr(i, 14) & "|R") = R
For j = 0 To UBound(D): V(R, D(j)) = Brr(i, E(j)): Next
Z(Brr(i, 14)) = V

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)