- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2019-11-16 16:41
| 只看該作者
Dear,
我不知道這個套表問題能否用函數解決,但因為表格中的資料大多用函數套出來的,所以在這裡發問...
...
PJChen 發表於 2019-11-5 19:02 
使用儲存格公式的方式我想不出來,
在此只能使用 Excel VBA 嘗試達成 :
只要點擊 廠缺表 的 "產生明細" 按鈕,
結果就出來了...
程式如下 :- Private Sub CbCreat_Click() ' 產生明細
- Dim iI%, iCol%
- Dim lRow&
- Dim sStr$
- Dim diPro, diTit, vA, vD1, vD2
- Dim wsSou As Worksheet, wsTar As Worksheet
-
- Set wsSou = Sheets("出貨")
- Set wsTar = Sheets("廠缺表")
- Set diPro = CreateObject("Scripting.Dictionary") ' 商品缺數
- Set diTit = CreateObject("Scripting.Dictionary") ' 據點列數
-
-
- With wsSou ' 讀取出貨資料
- iCol = 45 '廠缺起始行
- While .Cells(3, iCol) <> ""
- sStr = .Cells(3, iCol) ' 據點名
- lRow = 4 '商品起始列
- While .Cells(lRow, 8) <> "" ' 商品名稱
- If .Cells(lRow, iCol) > 0 Then
- If diPro.Exists(sStr) Then
- diPro(sStr) = diPro(sStr) & "," & lRow & "-" & .Cells(lRow, iCol)
- Else
- diPro(sStr) = lRow & "-" & .Cells(lRow, iCol)
- End If
- End If
- lRow = lRow + 1
- Wend
- iCol = iCol + 1
- Wend
- End With
-
- '12 粗 18
- '[d8].Font.ColorIndex = 23
- With wsTar ' 產生廠缺表
- .Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
- lRow = 6
- For Each vA In diPro
- With .Cells(lRow, 2).Resize(, 6) ' 據點名
- With .Cells(1)
- .Value = vA
- diTit(vA) = lRow
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- With .Font
- .Size = 22
- .Bold = False
- End With
- End With
-
- With .Interior
- .Pattern = xlPatternLinearGradient
- .Gradient.Degree = 90
- .Gradient.ColorStops.Clear
- With .Gradient.ColorStops.Add(0)
- .ThemeColor = xlThemeColorDark1
- .TintAndShade = 0
- End With
- With .Gradient.ColorStops.Add(1)
- .Color = 118671
- .TintAndShade = 0
- End With
- End With
- End With
- lRow = lRow + 1
-
- sStr = diPro(vA)
- vD1 = Split(sStr, ",")
- For iI = 0 To UBound(vD1)
- vD2 = Split(vD1(iI), "-")
- .Cells(lRow, 1) = wsSou.Cells(vD2(0), 6) ' 料號
- .Cells(lRow, 2) = wsSou.Cells(vD2(0), 8) ' 商品名稱
- .Cells(lRow, 4) = wsSou.Cells(vD2(0), 7) ' 箱入數
- .Cells(lRow, 5) = vD2(1) ' 欠瓶數
- .Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' 箱
- .Cells(lRow, 7) = vD2(1) Mod .Cells(lRow, 4) ' 瓶
- .Cells(lRow, 8) = wsSou.Cells(vD2(0), 5) ' 膠帶
- lRow = lRow + 1
- Next
- Next
-
- lRow = lRow - 1
- With .Range(.[B6], .Cells(lRow, 7))
- .Borders(xlEdgeLeft).LineStyle = xlContinuous
- .Borders(xlEdgeTop).LineStyle = xlContinuous
- .Borders(xlEdgeBottom).LineStyle = xlContinuous
- .Borders(xlEdgeRight).LineStyle = xlContinuous
- .Borders(xlInsideVertical).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- End With
- For Each vA In diTit
- With .Cells(diTit(vA), 2).Resize(, 6)
- .Borders(xlInsideVertical).LineStyle = xlNone
- .Borders(xlInsideHorizontal).LineStyle = xlNone
- End With
- Next
- End With
- MsgBox "缺料明細已產生完畢..."
- End Sub
複製代碼
自動套表-Ans.zip (51.69 KB)
|
|