Board logo

標題: [發問] 如何判定料號+批號其生產天數 [打印本頁]
作者: jsc0518    時間: 2021-11-19 13:33     標題: 如何判定料號+批號其生產天數

Dear all,
圖表說明如下圖。是否有公式可以帶出我想要的結果，現況是以人工計算，常會出錯
Thank you.

[attach]34409[/attach]

[attach]34410[/attach]
作者: samwang    時間: 2021-11-19 14:56

回復 1# jsc0518

請測試看看，謝謝
Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        m = xD(T)
        If Not xD.Exists(T1) Then Brr(m, 3) = Brr(m, 3) + 1
    Else
        n = n + 1: xD(T) = n: xD(T1) = n
        Brr(n, 1) = Arr(i, 2)
        Brr(n, 2) = Arr(i, 3)
        Brr(n, 3) = 1
    End If
Next
With Range("g2").Resize(n, 3)
    .Value = Brr
    .Sort Key1:=.Item(1), Order1:=1, _
          Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub
作者: hcm19522    時間: 2021-11-19 15:10

https://blog.xuite.net/hcm19522/twblog/590131891
作者: jsc0518    時間: 2021-11-19 17:52

回復 3# hcm19522

Dear hcm19522,

您好！感謝您的熱心指導與回覆。

與您請教，當公式我改成

=SUMPRODUCT((B$2:B$20000&C$2:C$20000=G2&H2)/COUNTIFS(A:A,A$2:A$20000,B:B,B$2:B$20000,C:C,C$2:C$20000))

它就有點類似當機一樣不會執行，是否是20000欄位太多了？

Thank you.
作者: jsc0518    時間: 2021-11-19 19:56

回復 2# samwang
Dear samwang,
晚上好！感謝您的熱心回覆與指導歐
剛剛測試一下與法式OK的，感恩
我等等會在小改一下您的語法，有問題再與您請教歐！
Thank you.
作者: jsc0518    時間: 2021-11-19 20:14

回復 2# samwang
Dear samwang,
我修改了語法，出現400錯誤。
說明一下，我把原本A~C欄位的工作表命名為"01"
而原本於G~I欄位我把它放在"02"(工作表名稱)
再請您指導我


語法更改如下

Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        m = xD(T)
        If Not xD.Exists(T1) Then Brr(m, 3) = Brr(m, 3) + 1
    Else
        n = n + 1: xD(T) = n: xD(T1) = n
        Brr(n, 1) = Arr(i, 2)
        Brr(n, 2) = Arr(i, 3)
        Brr(n, 3) = 1
    End If
Next

With Range([02!g2]).Resize(n, 3)
    .Value = Brr
    .Sort Key1:=.Item(1), Order1:=1, _
          Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub
作者: ML089    時間: 2021-11-19 20:16

J2 =COUNT(0/FREQUENCY((G2=B$2:B$99)*(H2=C$2:C$99)*A$2:A$99,A$2-2+ROW($1:$99)))-1
下拉
作者: jsc0518    時間: 2021-11-19 21:36

回復 7# ML089
Dear ML089,
晚上好！感謝您的熱心回復與指導
測試可以使用歐！
Thank you.
作者: jsc0518    時間: 2021-11-19 21:45

本帖最後由 jsc0518 於 2021-11-19 21:46 編輯

回復 7# ML089
Dear ML089,
剛剛試了一下，發現在相同日期有出現2次
在公式也是累計到有2次

但我希望是當日若有出現2次以上，公式幫我判斷算1次


Thank you.
作者: samwang    時間: 2021-11-19 22:24

回復 6# jsc0518


方便附件檔案嗎?
謝謝
作者: jsc0518    時間: 2021-11-19 22:59

回復 10# samwang
[attach]34411[/attach]

在幫我看一下檔案，謝謝
作者: samwang    時間: 2021-11-19 23:15

回復 11# jsc0518

With Range([02!g2]).Resize(n, 3)
>> With Sheets("02").Range("g2").Resize(n, 3)
請修改如上，謝謝   
作者: jsc0518    時間: 2021-11-20 06:49

回復 12# samwang
Dear samwang,
早安！我改了語法如下，但仍出現錯誤400的畫面
[attach]34412[/attach]




Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        m = xD(T)
        If Not xD.Exists(T1) Then Brr(m, 3) = Brr(m, 3) + 1
    Else
        n = n + 1: xD(T) = n: xD(T1) = n
        Brr(n, 1) = Arr(i, 2)
        Brr(n, 2) = Arr(i, 3)
        Brr(n, 3) = 1
    End If
Next

With Sheets("02").Range("g2").Resize(n, 3)
    .Value = Brr
    .Sort Key1:=.Item(1), Order1:=1, _
          Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub
作者: samwang    時間: 2021-11-20 07:51

回復 13# jsc0518


我測試沒問題如附件，已附上我測試的檔案，請再測試看看，謝謝
作者: jsc0518    時間: 2021-11-20 15:33

回復 14# samwang
Dear samwang,
謝謝你的幫忙囉!你所提供的附件檔案可以用，我在check我的excel哪裡有問題
感恩感恩！:)
作者: jsc0518    時間: 2021-11-20 15:56

回復 14# samwang
Dear samwang,
我在試run了語法，發現
在01工作表再次新增資料
2021/1/31  A123456  R001   ---> 這些我都設定同一日期(多列)
統計的數量又變成是出現"總"次數
如動態檔案操作
[attach]34415[/attach]
作者: samwang    時間: 2021-11-20 17:55

回復 16# jsc0518

2021/1/31  A123456  R001   ---> 這些我都設定同一日期(多列)
統計的數量又變成是出現"總"次數
>> 不好意思，更新如紅字，請測試看看，謝謝
Sub test2()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        m = xD(T)
        If Not xD.Exists(T1) Then Brr(m, 3) = Brr(m, 3) + 1: xD(T1) = n
    Else
        n = n + 1: xD(T) = n: xD(T1) = n
        Brr(n, 1) = Arr(i, 2)
        Brr(n, 2) = Arr(i, 3)
        Brr(n, 3) = 1
    End If
Next

With Sheets("02").Range("g2").Resize(n, 3)
    .Value = Brr
    .Sort Key1:=.Item(1), Order1:=1, _
          Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub   
作者: 准提部林    時間: 2021-11-20 18:03

回復 16# jsc0518


Sub test_1()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
[02!g:i].ClearContents '不累計, 這要先清空
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([01!a1], [01!c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|" & Arr(i, 3)
    T1 = Arr(i, 1) & "|" & T
    m = xD(T): xD(T1) = xD(T1) + 1
    If m = 0 Then
       n = n + 1: m = n: xD(T) = n
       Brr(n, 1) = Arr(i, 2): Brr(n, 2) = Arr(i, 3)
    End If
    If xD(T1) = 1 Then Brr(m, 3) = Brr(m, 3) + 1
Next
[02!g1:i1] = [{"料號","批號","天數"}]
With [02!g2].Resize(n, 3)
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=1, _
           Key2:=.Item(2), Order2:=1, Header:=2
End With
End Sub
作者: jsc0518    時間: 2021-11-20 18:17

回復 17# samwang
Dear samwang,
測試OK，感恩你的大幫忙！
作者: jsc0518    時間: 2021-11-20 18:18

回復 18# 准提部林
Dear 准提部林,
感謝你的熱心回復與教導歐
Test OK. 大感謝！！
作者: ML089    時間: 2021-11-20 19:37

回復 9# jsc0518

用你原來的檔案測試是OK的，裡面也有2天重複只計算1次
有新的測試檔案嗎?我看看萬提在哪裡?
作者: jsc0518    時間: 2021-11-20 20:46

回復 21# ML089
Dear ML089,
我修改了儲存格格式後，再套用你的公式，就OK了。
作者: Andy2483    時間: 2022-11-28 14:08

本帖最後由 Andy2483 於 2022-11-28 14:16 編輯

回復 18# 准提部林

謝謝 jsc0518 前輩發表此主題與範例
謝謝 准提部林前輩指導
以下學習前輩的程式碼心得,請前輩再指導!

'不了解題意不是問題!將前輩的程式碼一行行學習!就會知道題意!
'因為後學不是要解答!是學習!
Option Explicit
Sub test_1()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
'↑宣告變數
[02!g:i].ClearContents '不累計, 這要先清空
'↑名為"02"的工作表(以下稱:表二) G:I欄清除內容
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD 是字典
Arr = Range([01!a1], [01!c65536].End(3))
'↑令Arr 是陣列!倒入 名為"01"工作表(以下稱:表一),
'表一[A1]到C欄最後有內容的最小方正區域儲存格區域的值
ReDim Brr(1 To UBound(Arr), 1 To 3)
'↑宣告Brr陣列的範圍! 縱向從1到 Arr陣列縱向最大列號,橫向從1到3
For i = 2 To UBound(Arr)
'↑設順迴圈從2到 Arr陣列縱向最大列號
    T = Arr(i, 2) & "|" & Arr(i, 3)
    '↑令T字串變數 是迴圈列第二欄Arr陣列位置的值連接 "|" 符號,
    '再連接 迴圈列第三欄Arr陣列位置的值,(以下稱:料號|批號)
    T1 = Arr(i, 1) & "|" & T
    '↑令T1字串變數 是迴圈列第一欄Arr陣列位置的值連接 "|" 符號,
    '再連接 T變數 (以下稱: 日期|料號|批號)
    m = xD(T)
    '↑令m數字變數 是字典裡 料號|批號 為key對應的item
    '一開始m是初始值0
    '在i=2時!其實這一行程式碼已做了兩件事
    '1."A123456|R001"這字串已經藉由此行程式碼作為key,Item是字典初始值 Variant
    '2.m=0
   
    '換個方式敘述:查字典裡KEY是 "A123456|R001"的ITEM是什麼?找得到就把item給m
    '如果沒這個key! 就把這字串當key放進字典裡
   
    '如果能耐心的跟著繞迴圈理解!就會發現 m只是去查字典看 料號|批號 是在Brr陣列第幾列
   
    xD(T1) = xD(T1) + 1
    '↑令 日期|料號|批號 字串變數為key的item累加1
   
    '以前都覺得很奇怪前面程式碼又沒有這個變數!! 為什麼會在這裡 +1 ???
    '原來是以前都沒有變數初始值的觀念!所以都看不懂!
    '不是宣不宣告的問題! 不檢查宣告變數Option Explicit ,不宣告程式碼還是會跑!
    '只是被認定是通用變數!使用這個變數來做數學運算,他就是數字.....
   
    '沒有正統學習,駑鈍的資質就從學習跟錯誤中求進步!
    '字典好像也可以宣告他只裝數字或字串!再學習其他帖子就有機會學到了!
    '謝謝論壇!謝謝各位前輩!
   
   '所以 xD(T1) = xD(T1) + 1 只是在確定 日期|料號|批號 是不是全新組合!後方排除重複!  @2
    If m = 0 Then
    '↑如果m數字變數是0 ??(迴圈跑到 料號|批號 是第一次在字典裡查這key m才會是0)
       n = n + 1
       '↑令n數字變數開始累加1  這是要放Brr陣列結果的列位,如下方 @1標註位置
        '一開始n初始值是0
       '這是要新增一筆 全新組合的 料號|批號 放Brr陣列結果的列位
       m = n
       '↑令 m數字變數值=n數字變數值
       'n是要繼續累加!
       '所以也要有個變數,裝現在迴圈 料號|批號 放Brr陣列結果的列位 的列號
       xD(T) = n
       '↑令以 料號|批號 變數為key的item= n變數值
       Brr(n, 1) = Arr(i, 2) '@1
      '↑將迴圈列第二欄Arr陣列位置的值倒入 Brr陣列(n數字變數值列,第一欄)位置
       Brr(n, 2) = Arr(i, 3)  '@1
       '↑將迴圈列第三欄Arr陣列位置的值倒入 Brr陣列(n數字變數值列,第二欄)位置
    End If
    If xD(T1) = 1 Then '@2
    '↑如果 日期|料號|批號 字串變數為key的item 等於 1
    '雖然前面 都有把 料號|批號 放Brr陣列結果的列位 的列號m帶出來!
    '但是 日期|料號|批號 如果重複了!這條件是不會成立的!
       Brr(m, 3) = Brr(m, 3) + 1
       '↑讓 Brr陣列(m數字變數值列,第三欄)位置的值累加1
    End If
   
Next
[02!g1:i1] = [{"料號","批號","天數"}]
'↑令表二儲存格[G1:I1]依序倒入標題 "料號","批號","天數"
'又學到了!以前都只會 [02!G1:I1] = Array("料號", "批號", "天數")
With [02!g2].Resize(n, 3)
'↑以下是關於表二[G2]儲存格向下擴展n列,向右擴展3欄的範圍儲存格(以下稱:結果格)
     .Value = Brr
     '↑把Brr陣列的值倒入結果格
     .Sort KEY1:=.Item(1), Order1:=1, _
           Key2:=.Item(2), Order2:=1, Header:=2
     '↑結果格做排序
     '以前都以為是指定哪一儲存格做KEY1:,指定哪一儲存格做KEY2:
     '原來是抓排序儲存格的欄位而已
End With
End Sub
Sub 二層次_漸增排序()
Dim xA
Set xA = [G2:I7]
xA.Sort _
KEY1:=xA.Item(1), Order1:=xlAscending, _
Key2:=xA.Item(2), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub



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