如何移除陣列內重複的部分(STRING) - Excel程式區

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

2^#

發表於 2021-9-15 17:14 | 顯示全部帖子

回復 15# Andy2483

[C1].Resize(D.Count, 1) = D.KEYS
改為
[C1].Resize(D.Count, 1) = Application.Transpose(D.KEYS)

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

3^#

發表於 2021-9-16 15:32 | 顯示全部帖子

回復 18# Andy2483

問題：
1.請教上傳範例中的不重複日期陣列如何排序
2.請您指導陣列的觀念與語法.結構..等是否有錯或執行效率如何提升
3.執行結果將用於呈現統計圖表

回答
1.排序一般可以資料寫入表格後，再用EXCEL排序功能處理，參考如下

' 排序 J:L 範圍的資料
' Key1:=Range("J1") 依據 A 欄排序
' Order1:=xlAscending 升冪排序
' Header:=xlYes 有標題列
Range("J:L").sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlYes

2.我也是最近才在摸VBA不適很懂，我常用函數觀念在寫VBA有點怪怪的，我自己也在摸索中也跟大家一樣相互觀摩學習。

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

4^#

發表於 2021-9-16 17:00 | 顯示全部帖子

本帖最後由 ML089 於 2021-9-17 09:33 編輯

回復 18# Andy2483

程式可以分段插入 "時間器" 看看哪一段有問題
時間器如下表比較 **4**及**5**比較耗時，再深入探討

分段原始優化後
**1** 0 0.004
**2** 0.168 0.168
**3** 0.023 0.023
**4** 1.859 1.867 未修改
**5** 2.375 0.023 修正後
**6** 0.246 0.234

探討**5**程式， Arr有15000列，D字典有100列，用雙迴圈就有15000*100 計算步驟，
Arr是資料無法縮減迴圈，因此如何簡化 D字典這迴圈100步驟將是關鍵
可以考慮將 D字典的值加入序號就可以替代這100個迴圈
原先 2.375秒，經過優化後變成 0.023，剛好少100倍

修改參考如下

Debug.Print "**4**"
Debug.Print Format(Timer - tm, "0.000"): tm = Timer

'
'Set D = Nothing
'Set D = CreateObject("SCRIPTING.DICTIONARY")
'For i = 1 To UBound(Arr)
' TT = Arr(i, 交貨日期欄C)
' D(TT) = ""
'Next
'交貨日 = Application.Transpose(D.KEYS) '請教前輩日期陣列要怎麼排序??
'ReDim KLrr(1 To D.Count, 1 To 2)
'For x = 2 To UBound(Arr)
' Cdr = Arr(x, 交貨日期欄C)
' For i = 2 To D.Count
'    Jdr = 交貨日(i, 1)
'    If Cdr = Jdr Then
'       KLrr(i, 1) = KLrr(i, 1) + 1
'       KLrr(i, 2) = KLrr(i, 2) + Arr(x, SAP_PO欄M)
'       Exit For
'    End If
' Next
'Next

Set D = Nothing
Set D = CreateObject("SCRIPTING.DICTIONARY")
For i = 2 To UBound(Arr)
Cdr = Arr(i, 交貨日期欄C)
If Not D.Exists(Cdr) Then
      D(Cdr) = D.Count + 1
End If
Next
交貨日 = Application.Transpose(D.KEYS) '請教前輩日期陣列要怎麼排序??
ReDim KLrr(1 To D.Count, 1 To 2)
For x = 2 To UBound(Arr)
Cdr = Arr(x, 交貨日期欄C)
i = D(Cdr)
KLrr(i, 1) = KLrr(i, 1) + 1
KLrr(i, 2) = KLrr(i, 2) + Arr(x, SAP_PO欄M)
Next

Debug.Print "**5**"
Debug.Print Format(Timer - tm, "0.000"): tm = Timer

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

5^#

發表於 2021-9-16 17:28 | 顯示全部帖子

回復 18# Andy2483

你問題若與此版問題無關，最好另外開版詢問比較好。

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式