jsc0518

回復 10# samwang
1111.rar (8.57 KB)

下載次數: 4

2021-11-19 22:58

在幫我看一下檔案，謝謝

samwang

回復 11# jsc0518

With Range([02!g2]).Resize(n, 3)
>> With Sheets("02").Range("g2").Resize(n, 3)
請修改如上，謝謝   

jsc0518

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

下載 (61.17 KB)

2021-11-20 06:49

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

回復 13# jsc0518


我測試沒問題如附件，已附上我測試的檔案，請再測試看看，謝謝

jsc0518

回復 14# samwang
Dear samwang,
謝謝你的幫忙囉!你所提供的附件檔案可以用，我在check我的excel哪裡有問題
感恩感恩！:)

jsc0518

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

下載 (329.22 KB)

2021-11-20 15:56

samwang

回復 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   

准提部林

回復 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

回復 17# samwang
Dear samwang,
測試OK，感恩你的大幫忙！

jsc0518

回復 18# 准提部林
Dear 准提部林,
感謝你的熱心回復與教導歐
Test OK. 大感謝！！