- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 16
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
5#
發表於 2019-11-17 00:50
| 只看該作者
本帖最後由 luhpro 於 2019-11-17 01:17 編輯
回復 luhpro
請問大大,
一般我在用VBA時,用Alt + F11就可以看到Module的程式碼,為什麼您寫的程式看不到Module ?
PJChen 發表於 2019-11-16 23:12 
那只是我們的切換方式不同,
你只要點一下如下圖的 "檢視程式碼" 按鈕就可以看到了.
另外因為表格一開始的狀態都是空白的,填入資料時要從第3列開始,但在測試時都會從第6列開始填,可否幫忙改為起始由第3列開始寫入資料?
因為你的範例擋看到的是從第6列開始的.(隱藏了第3-5列)
需要修改底下這行數字 :
With wsTar ' 產生廠缺表
.Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
lRow = 3
For Each vA In diPro
還有底下這行 :
lRow = lRow - 1
With .Range(.[B3, .Cells(lRow, 7))
.Borders(xlEdgeLeft).LineStyle = xlContinuous
另外我的程式要放在另一檔案Macro.xlsm中執行,並指定檔名"最新庫存.xlsx"請問程式要怎麼修正?
Dim sStr$, sPath$, sFlName$
...
Set wsSou = ThisWorkbook.Sheets("出貨")
Set wsTar = Sheets("廠缺表") <=刪掉這行
Set diPro = CreateObject("Scripting.Dictionary") ' 商品缺數
sPath = ThisWorkbook.Path ' 如果要指定目錄, 只要改成該目錄即可, 如 sPath = "D:"
sFlName = "最新庫存.xlsx"
bMatch = False ' 檢查 '最新庫存.xlsx' 檔案是否已開啟
For iI = 1 To Workbooks.Count
If Workbooks(iI).Name = sFlName Then
bMatch = True
Exit For
End If
Next iI
If bMatch Then
Set wsTar = Workbooks(sFlName).Sheets("廠缺表")
wsTar.Activate
Else
Set wsTar = Workbooks.Open(Filename:=sPath & "\" & sFlName).Sheets("廠缺表")
End If
最後, 原先的檔案中,
字形大小與箱入數顏色忘了改,
就一併處理了 :
With .Range(.[B3], .Cells(lRow, 7))
.Font.Size = 18
...
End With
For Each vA In diTit
...
Next
With .Range(.[D3], .Cells(lRow, 3))
.Font.ColorIndex = 23
End With
修改後完整程式如下 :
Private Sub CbCreat_Click() ' 產生明細
Dim iI%, iCol%
Dim lRow&
Dim sStr$, sPath$, sFlName$
Dim bMatch As Boolean
Dim diPro, diTit, vA, vD1, vD2
Dim wsSou As Worksheet, wsTar As Worksheet
Set wsSou = ThisWorkbook.Sheets("出貨")
Set diPro = CreateObject("Scripting.Dictionary") ' 商品缺數
Set diTit = CreateObject("Scripting.Dictionary") ' 據點列數
sPath = ThisWorkbook.Path ' 如果要指定目錄, 只要改成該目錄即可, 如 sPath = "D:"
sFlName = "最新庫存.xlsx"
bMatch = False ' 檢查 '最新庫存.xlsx' 檔案是否已開啟
For iI = 1 To Workbooks.Count
If Workbooks(iI).Name = sFlName Then
bMatch = True
Exit For
End If
Next iI
If bMatch Then
Set wsTar = Workbooks(sFlName).Sheets("廠缺表")
wsTar.Activate
Else
Set wsTar = Workbooks.Open(Filename:=sPath & "\" & sFlName).Sheets("廠缺表")
End If
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
With wsTar ' 產生廠缺表
.Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
lRow = 3
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(.[B3], .Cells(lRow, 7))
.Font.Size = 18
.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
With .Range(.[D3], .Cells(lRow, 3))
.Font.ColorIndex = 23
End With
End With
MsgBox "缺料明細已產生完畢..."
End Sub
 自動套表-Ans2.zip (56.31 KB)
|
|
