返回列表 上一主題 發帖

[發問] 自動套表

[發問] 自動套表

Dear,
我不知道這個套表問題能否用函數解決,但因為表格中的資料大多用函數套出來的,所以在這裡發問...    自動套表.rar (34.84 KB)
        出貨sheet是一個每天出貨用的表格,所以資料是變動的
        因為檔案很大,我把與補貨明細無關的資料都Delete,避免干擾
        每天的缺貨都需要這張報表去發給補貨的單位
        除了表頭1:2外,這張報表每天初始都是空白的
        我要把出貨sheet的資料套進來,請教用函數比較好做,還是VBA?
       
        出貨sheet要套過來的貨料:
1..        有缺貨的部份,依序從AS:BH帶資料
2..        我先做一個2個範例"林口" & "暖暖1"
3..        現在無法達成的部份在於
        要如何讓有缺貨的AS:BH的表頭自動帶到這裡的B欄?但無缺貨的自動跳過!
        並且讓缺貨的料號自動帶到A欄?
4..        第2筆缺貨的表頭 "暖暖1"帶入B欄,料號自動帶到A欄後
        如何讓E欄的公式以暖暖1為對象?而不用各別修改公式?
例:        =SUMPRODUCT((出貨!$F$4:$F$12=$A7)*(出貨!$AS$3:$BH$3=B$6)*(出貨!$AS$4:$BH$12))
        如何讓(出貨!$AS$3:$BH$3自動搜尋B$6),而不用各別改?

Dear,
我不知道這個套表問題能否用函數解決,但因為表格中的資料大多用函數套出來的,所以在這裡發問...   
...
PJChen 發表於 2019-11-5 19:02


使用儲存格公式的方式我想不出來,
在此只能使用 Excel VBA 嘗試達成 :
只要點擊 廠缺表 的 "產生明細" 按鈕,
結果就出來了...
程式如下 :
  1. Private Sub CbCreat_Click() ' 產生明細
  2.   Dim iI%, iCol%
  3.   Dim lRow&
  4.   Dim sStr$
  5.   Dim diPro, diTit, vA, vD1, vD2
  6.   Dim wsSou As Worksheet, wsTar As Worksheet
  7.   
  8.   Set wsSou = Sheets("出貨")
  9.   Set wsTar = Sheets("廠缺表")
  10.   Set diPro = CreateObject("Scripting.Dictionary") ' 商品缺數
  11.   Set diTit = CreateObject("Scripting.Dictionary") ' 據點列數
  12.   
  13.   
  14.   With wsSou ' 讀取出貨資料
  15.     iCol = 45 '廠缺起始行
  16.     While .Cells(3, iCol) <> ""
  17.       sStr = .Cells(3, iCol) ' 據點名
  18.       lRow = 4 '商品起始列
  19.       While .Cells(lRow, 8) <> "" ' 商品名稱
  20.         If .Cells(lRow, iCol) > 0 Then
  21.           If diPro.Exists(sStr) Then
  22.             diPro(sStr) = diPro(sStr) & "," & lRow & "-" & .Cells(lRow, iCol)
  23.           Else
  24.             diPro(sStr) = lRow & "-" & .Cells(lRow, iCol)
  25.           End If
  26.         End If
  27.         lRow = lRow + 1
  28.       Wend
  29.       iCol = iCol + 1
  30.     Wend
  31.   End With
  32.   
  33. '12 粗 18
  34. '[d8].Font.ColorIndex = 23


  35.   With wsTar ' 產生廠缺表
  36.     .Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
  37.     lRow = 6
  38.     For Each vA In diPro
  39.       With .Cells(lRow, 2).Resize(, 6) ' 據點名
  40.         With .Cells(1)
  41.           .Value = vA
  42.           diTit(vA) = lRow
  43.           .HorizontalAlignment = xlCenter
  44.           .VerticalAlignment = xlCenter
  45.           With .Font
  46.             .Size = 22
  47.             .Bold = False
  48.           End With
  49.         End With
  50.         
  51.         With .Interior
  52.             .Pattern = xlPatternLinearGradient
  53.             .Gradient.Degree = 90
  54.             .Gradient.ColorStops.Clear
  55.           With .Gradient.ColorStops.Add(0)
  56.             .ThemeColor = xlThemeColorDark1
  57.             .TintAndShade = 0
  58.           End With
  59.           With .Gradient.ColorStops.Add(1)
  60.             .Color = 118671
  61.             .TintAndShade = 0
  62.           End With
  63.         End With
  64.       End With
  65.       lRow = lRow + 1
  66.       
  67.       sStr = diPro(vA)
  68.       vD1 = Split(sStr, ",")
  69.       For iI = 0 To UBound(vD1)
  70.         vD2 = Split(vD1(iI), "-")
  71.         .Cells(lRow, 1) = wsSou.Cells(vD2(0), 6) ' 料號
  72.         .Cells(lRow, 2) = wsSou.Cells(vD2(0), 8) ' 商品名稱
  73.         .Cells(lRow, 4) = wsSou.Cells(vD2(0), 7) ' 箱入數
  74.         .Cells(lRow, 5) = vD2(1) ' 欠瓶數
  75.         .Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' 箱
  76.         .Cells(lRow, 7) = vD2(1) Mod .Cells(lRow, 4) ' 瓶
  77.         .Cells(lRow, 8) = wsSou.Cells(vD2(0), 5) ' 膠帶
  78.         lRow = lRow + 1
  79.       Next
  80.     Next
  81.    
  82.     lRow = lRow - 1
  83.     With .Range(.[B6], .Cells(lRow, 7))
  84.       .Borders(xlEdgeLeft).LineStyle = xlContinuous
  85.       .Borders(xlEdgeTop).LineStyle = xlContinuous
  86.       .Borders(xlEdgeBottom).LineStyle = xlContinuous
  87.       .Borders(xlEdgeRight).LineStyle = xlContinuous
  88.       .Borders(xlInsideVertical).LineStyle = xlContinuous
  89.       .Borders(xlInsideHorizontal).LineStyle = xlContinuous
  90.     End With
  91.     For Each vA In diTit
  92.       With .Cells(diTit(vA), 2).Resize(, 6)
  93.         .Borders(xlInsideVertical).LineStyle = xlNone
  94.         .Borders(xlInsideHorizontal).LineStyle = xlNone
  95.       End With
  96.     Next
  97.   End With
  98.   MsgBox "缺料明細已產生完畢..."
  99. End Sub
複製代碼
自動套表-Ans.zip (51.69 KB)

TOP

回復 2# luhpro
真是太感謝了...

TOP

本帖最後由 PJChen 於 2019-11-16 23:17 編輯

回復 2# luhpro

請問大大,
一般我在用VBA時,用Alt + F11就可以看到Module的程式碼,為什麼您寫的程式看不到Module ?
另外因為表格一開始的狀態都是空白的,填入資料時要從第3列開始,但在測試時都會從第6列開始填,可否幫忙改為起始由第3列開始寫入資料?
另外我的程式要放在另一檔案Macro.xlsm中執行,並指定檔名"最新庫存.xlsx"請問程式要怎麼修正?
謝謝您

TOP

本帖最後由 luhpro 於 2019-11-17 01:17 編輯
回復  luhpro

請問大大,
一般我在用VBA時,用Alt + F11就可以看到Module的程式碼,為什麼您寫的程式看不到Module ?

PJChen 發表於 2019-11-16 23:12

那只是我們的切換方式不同,
你只要點一下如下圖的 "檢視程式碼" 按鈕就可以看到了.
檢視程式碼按鈕.jpg
2019-11-17 00:51


另外因為表格一開始的狀態都是空白的,填入資料時要從第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)

TOP

回復 5# luhpro

感謝 大大,
執行沒有問題了

TOP

回復 5# luhpro

SOS
大大,
我依實際需求,小小的改了程式,測試時也都沒問題,但...
程式在正式使用時,發生了問題
停在這裡 ".Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' 箱"
而且跑出一些測試時未曾出現的資料,
我把它留在執行結果中,
請幫忙看下....感謝
3rd_程式與執行檔 分開.rar (136.08 KB)

TOP

本帖最後由 luhpro 於 2019-11-20 00:01 編輯
回復  luhpro

SOS
大大,
我依實際需求,小小的改了程式,測試時也都沒問題,但...
程式在正式使用時,發 ...
PJChen 發表於 2019-11-19 22:01

首先修正一個錯誤, 紅色這一行要移到這裡 :
  End If
    Set wsSou = Workbooks(sFlName).Sheets("飛比")
  With wsSou ' 讀取飛比資料
我們不能在 "最新庫存.xlsx" 這個檔案還沒打開前就去參照它.

其次回答你的問題,
那行有問題是因為 vD2(1) 是 空字串 (即 "" ),
系統不接受將它用來參與計算式.
再考慮到你的欠瓶數會出現日期,
所以我從源頭直接濾掉不符合數字格式的資料 :
  Dim rTar As Range
...
      sStr = .Cells(3, iCol) ' 據點名
      lRow = 4 '商品起始列
      While .Cells(lRow, 8) <> "" ' 商品名稱
        Set rTar = .Cells(lRow, iCol)
        If rTar > 0 And rTar <> "" And InStr(1, rTar, "/") = 0 Then
          If diPro.Exists(sStr) Then
            diPro(sStr) = diPro(sStr) & "," & lRow & "-" & rTar
...
        vD2 = Split(vD1(iI), "-")
        sStr = vD2(1)
...
        .Cells(lRow, 5) = sStr ' 欠瓶數
        '.Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' 箱 <= 刪除這行
        If InStr(1, sStr, "箱") > 0 Then ' 處理有 "箱+" 的字串
          .Cells(lRow, 6) = Left(sStr, InStr(1, sStr, "箱") - 1) ' 箱
          .Cells(lRow, 7) = Val(Mid(sStr, InStr(1, sStr, "箱") + 1)) ' 瓶
        Else ' 正常的瓶數
          .Cells(lRow, 6) = Int(sStr / .Cells(lRow, 4)) ' 箱
          .Cells(lRow, 7) = sStr Mod .Cells(lRow, 4) ' 瓶
        End If

最後, 因為有 "箱+" 的字串太長不能全部顯示出來,
故調整 E 欄欄寬 :
    .Columns("E").AutoFit
  End With
  MsgBox "缺料明細已產生完畢..."
Macro-2.zip (21.63 KB)

TOP

回復 8# luhpro

大大,
測試後."似乎"看不出有改變吔...
有缺貨的部份,依序從"飛比"AS:BH帶資料,測試檔中的缺貨其實只有一項(72瓶)
可是製表完成後會把訂單的數量帶到廠缺!!
另外也想請問,日後若出貨據點增加時,"飛比"AS:BH欄數也會增加,請問當據點增加時要如何修改?

TOP

本帖最後由 luhpro 於 2019-11-20 22:31 編輯
回復  luhpro

大大,
有缺貨的部份,依序從"飛比"AS:BH帶資料,
測試檔中的缺貨其實只有一項(72瓶), ...
PJChen 發表於 2019-11-20 21:03


嗯? 還是跟之前一樣會發生錯誤嗎?
8# 主要是解決 ""(空字串) 與 "箱+" 造成計算錯誤的問題,
不過依你所述那其實是你沒要抓取的部分.
所以你變成只要把 7# 的程式修改這一行應該就是你要的結果了 :
    iCol = 45 '廠缺來源起始欄
    While .Cells(3, iCol) <> "劃單合計"
      sStr = .Cells(3, iCol) ' 據點名

不過這個仍然要改 :
sFlName = "最新庫存.xlsx"
  Set wsSou = Workbooks(sFlName).Sheets("飛比")
  Set diPro = CreateObject("Scripting.Dictionary") ' 商品缺數
紅色這一行要移到這裡 :
End If
    Set wsSou = Workbooks(sFlName).Sheets("飛比")
   With wsSou ' 讀取飛比資料

另外, 這行也要修改 :
  With wsTar ' 產生廠缺表
    .Range(.[A3], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
    lRow = 3

另外也想請問,日後若出貨據點增加時,"飛比"AS:BH欄數也會增加,請問當據點增加時要如何修改?

要加上據點,
只要在 "劃單合計" (即 BI 欄)左方插入整欄並賦與資料即可.

TOP

        靜思自在 : 修行要繫緣修心,藉事練心,隨處養心。
返回列表 上一主題