返回列表 上一主題 發帖

出貨單建立

出貨單建立

請問各位先進,目前遇到此問題
我先在資料輸入打完資料後,將所有資料匯至出貨資料這區塊
想在出貨資料分頁將A欄也帶入單號
請問要如讓將單號這欄,可以自動判定B欄位這次新增多少"圖號",''將單號複製在A欄位

test.rar (24.65 KB)

今天練習字典,把3種分類(廠商.規格.圖號)各做數量總計與金額總計

test_1_20221027_2.zip (76.52 KB)

選單:


廠商分類/總計:


規格分類/總計:


圖號分類/總計:


主要練習修改:

    Y(T & "/數量") = Y(T & "/數量") + Arr(i, 5)
    Y(T & "/金額") = Y(T & "/金額") + Arr(i, 7)

    Y(T & "|") = Crr  '#1
    '↑令 客戶 &"|"字串 為key ,令Crr為它的item,
   
~~~
         .Cells(Y(.Name) + 1, 1) = "總計"
         .Cells(Y(.Name) + 1, 5) = Y(Replace(Z, "|", "/數量"))
         .Cells(Y(.Name) + 1, 7) = Y(Replace(Z, "|", "/金額"))
         .Rows(Y(.Name) + 1).Font.Bold = True
         .Columns(1).Font.Bold = True

         .Cells.Columns.AutoFit
         '↑令整表的所有欄位自動調整欄寬
         .Cells(Y(.Name) + 2, 1) = "以上以 廠商 分類彙整日期區間為: " & Dats & "~" & Datn
         '↑資料最後下一列A欄加入整理日期區間
         .Cells(Y(.Name) + 2, 1).Font.ColorIndex = 5
         '↑資料最後下一列A欄字色變藍色
         .Cells(Y(.Name) + 2, 1).Font.Bold = True
         '↑資料最後下一列A欄字變粗體
      End With

TOP

主要程式碼變更如下:
Option Explicit
Public Dats As Date, Datn As Date, AC_WO_NA
'↑設為全域變數!給各運用此副程式的主程式運用
Sub 長序號轉_日期_短序號()
Dim Arr, i&, xB, N&, D1 As Date, TTT
'↑宣告變數:D1 是日期,N是數字
Set xB = Sheets("出貨資料")
'↑令xB是 "出貨資料" 工作表
Dats = 0
'↑起始日歸零
Datn = 0
'↑結束日歸零
If IsDate(xB.[I1]) Then
'↑如果 出貨資料表的[I1]是日期
   Dats = xB.[I1]
   '↑起始日就裝入這日期
End If
If IsDate(xB.[J1]) Then
'↑如果 出貨資料表的[J1]是日期
   Datn = xB.[J1]
   '↑結束日就裝入這日期
End If
Arr = xB.Range(xB.[J1], Cells(xB.UsedRange.EntireRow.Count, 1))
'↑令Arr是"出貨資料" 工作表 A:G欄之間有使用列的區域儲存格值
For i = 2 To UBound(Arr)
'↑設迴圈拆解B欄的長序號
   D1 = "20" & Mid(Arr(i, 2), 1, 2) & "/" & Mid(Arr(i, 2), 3, 2) & "/" & Mid(Arr(i, 2), 5, 2)
   '↑ "20",加長序號第1個字開始取兩字元="22"
   ',再加長序號第3個字開始取兩字元="10"
   ',再加長序號第5個字開始取兩字元="08"
   'D1="2022/10/08"字串轉化為日期,因D1宣告為日期
   Arr(i, 9) = D1
   '↑把D1日期放入Arr的第9欄位置
   N = Right(Arr(i, 2), 3)
   '↑令N是常序號的右邊3個字元字串轉數字,因N宣告為數字
   Arr(i, 10) = N
   '↑把N數字放入Arr的第10欄位置
Next
Workbooks.Add
'↑開一個新的檔案
AC_WO_NA = ActiveWorkbook.Name
Sheets(1).Name = "出貨資料"
[A1].Resize(UBound(Arr), 10) = Arr
'↑把Arr陣列的資料從[A1]開始倒入新工作表的存格
If Datn = 0 Then
'↑如果結束日是歸零狀態?
   Datn = CDate(WorksheetFunction.Max([I:I]))
   '↑條件成立!就抓[I:I]裡的最大日期裝進結束日
End If
If Dats = 0 Then
'↑如果起始日是歸零狀態?
   Dats = CDate(WorksheetFunction.Min([I:I]))
   '↑條件成立!就抓[I:I]裡的最小日期裝進開始日
End If
[I1] = "出貨日期"
[J1] = "當日序號"
Cells.Columns.AutoFit
'↑自動調整欄寬
Cells.Rows.AutoFit
'↑自動調整列高
[2:2].Select
ActiveWindow.FreezePanes = True
'↑第二列以上儲存格凍結窗格
[A1].Select
[A1].AutoFilter
'↑設定篩選
Cells.Borders.LineStyle = xlContinuous
'↑顯示格線
End Sub

Option Explicit
Sub 客戶出貨金額_統計圖表()
Application.ScreenUpdating = False
'↑執行時螢幕畫面不要跟著變動
Call 長序號轉_日期_短序號

Dim Yrr, i&, xD, Arr, Brr, d, c, R
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Set Yrr = [出貨資料!A1].CurrentRegion
'↑令 Yrr是 [A1]相鄰非空格所串連起來的儲存格,擴展到方正區域的最小範圍儲存格
c = [出貨資料!A1].End(xlToRight).Column
'↑令C是此表的欄數
R = [出貨資料!A1].End(xlDown).Row
'↑令R是此表的列數
For i = 2 To R
'↑設迴圈將客戶名利用字典去除重複並累加 G欄的金額
   If Yrr(i, 9) < Dats Or Yrr(i, 9) > Datn Then
   '↑如果 I欄日期是小於開始日 或 I欄日期是大於結束日?
      GoTo 999
      '↑條件成立!就跳到 999的位置繼續執行!
   End If
   If Yrr(i, 1) <> "" Then
      d = Yrr(i, 1)
      xD(d) = xD(d) + Yrr(i, 7)
   End If
   
999
Next
Arr = Application.Transpose(xD.KEYS)
'↑令Arr 是字典key轉置之後的二維陣列
Brr = Application.Transpose(xD.Items)
'↑令Brr 是字典Item轉置之後的二維陣列
Workbooks.Add
'↑開啟一個新檔案
[A1] = "客戶"
[B1] = "出貨金額統計(NT)/統計區間(" & Dats & "~" & Datn & ")"
'↑圖表標題加入整理日期區間
[A2].Resize(UBound(Arr), 1) = Arr
'↑將 Arr陣列從[A2]貼入值
[B2].Resize(UBound(Brr), 1) = Brr
'↑將 Brr陣列從[B2]貼入值
[A1].CurrentRegion.Sort _
KEY1:=[B1], Order1:=xlDescending, Header:=xlYes
'↑資料有抬頭列的漸減排序
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("圖表 1")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
End With
[A1].Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPieExploded
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("圖表 2")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
   .IncrementTop 400
End With
ActiveSheet.ChartObjects("圖表 2").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.Position = xlLabelPositionOutsideEnd
'↑錄製巨集就可以產生這兩個圖表!視需求調整!
[A1].Activate
Workbooks(AC_WO_NA).Close False
Set xD = Nothing
Set Arr = Nothing
Set Brr = Nothing
End Sub

TOP

圖表變更如下:



彙整分類變更如下:


TOP

各位前輩早安
今早將統計圖表與分類彙整加入了日期區間的設定功能!
請各位前輩不吝指教!
test_1_20221026_1.zip (72.46 KB)

1.可在紅色框處填入日期
2.如果起始日沒填!抓資料最小日期
3.如果結束日沒填!抓資料最大日期
4.都沒填!各抓資料最小日期&抓資料最大日期

TOP

學習到了!應用上了!留下足跡!還當作做筆記!
多年以後再回來這帖看看自己學的太少!
新增功能按鈕:


結果1:


結果2,3:

TOP

回復 33# cclo0728
謝謝前輩回覆
學習是一件很有意思的事
http://forum.twbts.com/thread-387-1-1.html
以上這帖學習到的方法應用在前輩的範例上:
test_1_20221021.zip (61.49 KB)

如果按鈕多了!可以用菜單按鈕處理一下!


按鈕後:

TOP

回復 32# Andy2483
高手,都是一直無止盡的進步
還有很多地方要與高手學習:)

TOP

本帖最後由 Andy2483 於 2022-10-17 08:13 編輯

各位前輩好
今天運用此範例整理了:
1.資料表看到哪裡!滑鼠左鍵快按兩下就篩選
2.抬頭列格快按兩下就全部顯示

篩選前滾動卷軸隨機查看資料:


看到想篩選的關鍵字!就左鍵快擊兩次


左鍵快擊兩次後的結果:


想快速全部顯示!就按抬頭列A1儲存格:


以下程式碼心得註解供參考,請各位前輩只正並指導!

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim V$
With Target
'↑以下是有關於左鍵雙擊事件的程序

   If .Address = "$A$1" Then
   '↑如果左鍵雙擊的位址是 "$A$1"
   
      If ActiveSheet.AutoFilter Is Nothing Then
      '↑如果工作表沒有使用篩選
      
         [A1].AutoFilter
         '↑令 [A1]相鄰非空格所串連起來的儲存格,擴展到方正區域的最小範圍
         ',的第一列設定篩選

         
         Else
         '↑否則 如果工作表有使用篩選
         
            If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            '↑如果工作表是在篩選中! 就顯示全部資料
            
      End If
      Cancel = True
   End If
   If .Column = [A1].Column And .Row > 1 Then
   '↑如果左鍵雙擊是 A欄 而且是大於第一列
   
      V = Trim(.Value)
      '↑令V左鍵雙擊格裡頭尾去空白字元的字串
      
      If Trim(.Value) = "" Then
      '↑如果左鍵雙擊格的值(去除頭尾的空白字元)之後,是空字元
        
         Cancel = True
         '↑取消事件的執行
         
         Exit Sub
         '↑結束此程式執行
         
      End If
      If ActiveSheet.AutoFilter Is Nothing Then
      '↑如果工作表沒有使用篩選
      
         [A1].AutoFilter
         '↑令 [A1]相鄰非空格所串連起來的儲存格,擴展到方正區域的最小範圍
         ',的第一列設定篩選
         
         Else
         '↑否則 如果工作表有使用篩選
         
            If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            '↑如果工作表是在篩選中! 就顯示全部資料
            
      End If
      Selection.AutoFilter Field:=1, Criteria1:=V
      '↑第一欄執行篩選!篩選的關鍵字就是雙擊這格的去頭去尾字串
      
      ActiveWindow.ScrollColumn = 1
      '↑螢幕畫面捲到最左邊
      
      'ActiveWindow.ScrollRow = 1
      '↑螢幕畫面捲到最上面
      
      Cancel = True
      '↑取消事件的執行
      
   End If
End With
End Sub

TOP

各位前輩好
今天後學練習以字典與陣列做統計,並土法煉鋼產生圖表
請各位前輩指正並指導

原始資料:


產生新檔案圖表:


Option Explicit
Sub 客戶出貨金額_統計圖表()
Application.ScreenUpdating = False
'↑執行時螢幕畫面不要跟著變動

Dim Yrr, i&, xD, Arr, Brr, d
'↑宣告變數

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典

Yrr = [出貨資料!A1].CurrentRegion.Offset(1, 0)
'↑令 "出貨資料表"([A1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,往下偏移一列 )值是陣列 Yrr


For i = 1 To UBound(Yrr)
'↑設迴圈將客戶名利用字典去除重複並累加 G欄的金額
   If Yrr(i, 1) <> "" Then
      d = Yrr(i, 1)
      xD(d) = xD(d) + Yrr(i, 7)
   End If
Next

Arr = Application.Transpose(xD.keys)
'↑令Arr 是字典key轉置之後的二維陣列

Brr = Application.Transpose(xD.Items)
'↑令Brr 是字典Item轉置之後的二維陣列

Workbooks.Add
'↑開啟一個新檔案

[A1] = "客戶"
[B1] = "出貨金額統計(NT)"
[A2].Resize(UBound(Arr), 1) = Arr
'↑將 Arr陣列從[A2]貼入值

[B2].Resize(UBound(Brr), 1) = Brr
'↑將 Brr陣列從[B2]貼入值

[A1].CurrentRegion.Sort _
KEY1:=[B1], Order1:=xlDescending, Header:=xlYes
'↑資料有抬頭列的漸減排序

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("圖表 1")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
End With
[A1].Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPieExploded
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("圖表 2")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
   .IncrementTop 400
End With
ActiveSheet.ChartObjects("圖表 2").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.Position = xlLabelPositionOutsideEnd
'↑錄製巨集就可以產生這兩個圖表!視需求調整!

[A1].Activate
Set xD = Nothing
Set Arr = Nothing
Set Brr = Nothing
End Sub

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題