Board logo

標題: [發問] 如何移除陣列內重複的部分(STRING) [打印本頁]
作者: PKKO    時間: 2014-11-9 08:40     標題: 如何移除陣列內重複的部分(STRING)

MyArray() ="XX","aa","ab",XX","ab"
如何可取得"XX","aa","ab"的值呢(不重複)
作者: GBKEE    時間: 2014-11-9 17:09

回復 1# PKKO

試試看
  1. Option Explicit
  2. Sub EX()
  3.     Dim AR, D As Object, E As Variant
  4.     AR = Array("XX", "aa", "ab", "ab", "ab", "XX", "ab")
  5.     Set D = CreateObject("SCRIPTING.DICTIONARY")  '字典物件
  6.     For Each E In AR
  7.         D(E) = ""
  8.     Next
  9.     AR = D.KEYS
  10.     MsgBox Join(AR, vbLf)
  11.     Stop
  12.     MsgBox Join(D.KEYS, vbLf)  '同上
  13. End Sub
複製代碼
作者: PKKO    時間: 2014-11-9 23:15

回復 2# GBKEE

版大太強大了,完全可以使用
可否請教一下
For Each E In AR

        D(E) = ""

    Next

為何要讓每一個陣列內的D物件都變成""
Keys 方法 Returns an array containing all existing keys in a Dictionary object.
D.KEYS
實際上這個的意思不是很懂!
作者: GBKEE    時間: 2014-11-10 12:40

回復 3# PKKO
為何要讓每一個陣列內的D物件都變成""
因為用不到啊
  1. Option Explicit
  2. Sub EX()
  3.     Dim d                   '建立一個變數
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     '***********************
  6.     d.Add "a", "Athens"     '加入一些關鍵字和項目
  7.     d.Add "b", "Belgrade"
  8.     d.Add "c", "Cairo"
  9.     MsgBox Join(d.items, vbLf) '項目
  10.     MsgBox Join(d.keys, vbLf)  '關鍵字
  11. End Sub
複製代碼
作者: PKKO    時間: 2014-11-11 00:24

回復 4# GBKEE

感謝版大,已經了解,跑迴圈的用途是讓D物件會在陣列之內
在迴圈內讓值為"" 實際上只是items會變成""
不影響關鍵字,因此KEYS可以正常輸出,感恩!!
作者: li_hsien    時間: 2020-5-14 09:40

回復 2# GBKEE

2014年的文章到了2020還是非常實用

這方法幫我解決陣列移除重複的問題

對於字典的用法不是很清楚
一直不懂為什麼
  1. For Each E In AR
  2.     D(E) = ""
  3. Next
  4. AR = D.KEYS
複製代碼
可以達到移除重複的效果

我看了下方的回覆還是不清楚@@

再請版主指教

謝謝
作者: n7822123    時間: 2020-5-18 05:13

回復 1# PKKO

提供一個不使用字典物件的寫法

Arr 處理過後 得到一個 不重複的 Brr 陣列
  1. Sub test()
  2. Arr = Array("XX", "aa", "ab", "ab", "ab", "XX", "ab")
  3. T$ = ""
  4. For Each Item In Arr
  5.   If InStr(T$, Item) = 0 Then T = Trim(T & " " & Item)
  6. Next
  7. Brr = Split(T, " ")
  8. End Sub
複製代碼
作者: ML089    時間: 2020-5-18 11:40

回復 6# li_hsien

原先
For Each E In AR
    D(E) = ""
Next
AR = D.KEYS


改為，將 E 改為 Key，是否比較有感覺
For Each Key In AR
    D(Key) = ""
Next
AR = D.KEYS


因為字典陣列 D(Key)裡的Key不會有重複值，
當 Key 從 AR 陣列取出有重複值時，會以前一個相同Key值的 D(Key) 為位置。


D(Key) = ""，後面賦值是甚麼不重要，因為後面用 D.KEYS 取出不重複值。


~ 個人解讀，供你參考 ~
作者: 准提部林    時間: 2020-5-18 11:45

本帖最後由 准提部林 於 2020-5-18 11:46 編輯

回復 6# li_hsien

D(Key) = Item
可將Key比喻為不同的人, 而每一個人背個包包, 這包包可裝任何東西(Item),
Key值是唯一的(每個人在世上都是唯一的), 而Item可賦于其相關聯的內容, 或為空(包包不裝東西),
因為目的只是要取得不重覆值(即Key值), 所以用空字符""為Item,
__亦即每一個人都揹個空包包, 認人不認包
D(Key)=""
D(Key)=1
D(Key)="A"
都可以得到相同效果, 1及A是隨意給的,但在這裡毫無意義~~


================================
作者: 准提部林    時間: 2020-5-18 11:51

回復 7# n7822123


If InStr(" " & T$ & " "," " & Item & " ") = 0 Then T = Trim(T & " " & Item)
用分隔符號將字串包覆再比對, 避免錯判,
例如:"AA", "AAA", "張三", "張三郎" 會有所混淆~~
作者: n7822123    時間: 2020-5-18 12:44

本帖最後由 n7822123 於 2020-5-18 12:46 編輯

回復 10# 准提部林


哈哈，感謝準大糾正~~~ 是我欠考慮了

修正程式
  1. Sub test()
  2. Arr = Array("XX", "aa", "ab", "ab", "ab", "XX", "ab")
  3. T$ = ""
  4. For Each Item In Arr
  5.   If InStr(" " & T$ & " "," " &  Item & " ") = 0 Then T = Trim(T & " " & Item)
  6. Next
  7. Brr = Split(T, " ")
  8. End Sub
複製代碼
作者: li_hsien    時間: 2020-5-19 09:16

回復 8# ML089

感謝M大

你一用Key取代原有的E
再加上說明 一切就清楚了

理解如下:
作法其實是用字典的Key不會重複的特性
把陣列值加到字典Key值
最後再印出Key值就是不重複的結果了!
作者: li_hsien    時間: 2020-5-19 09:18

回復 9# 准提部林

感謝准提部林版主熱心回覆

看了8樓M大解說

明瞭了 !

謝謝
作者: li_hsien    時間: 2020-5-19 09:22

回復 11# n7822123

沒用過InStr操作

學習了 感謝大大分享
作者: Andy2483    時間: 2021-9-15 15:53

回復 9# 准提部林


    前輩好
請教前輩 附件範例要整理不重複品號,哪裡錯了?
作者: ML089    時間: 2021-9-15 17:14

回復 15# Andy2483

    [C1].Resize(D.Count, 1) = D.KEYS
改為
    [C1].Resize(D.Count, 1) = Application.Transpose(D.KEYS)
作者: Andy2483    時間: 2021-9-16 07:04

回復 16# ML089


    謝謝前輩指導
key是橫向排列的,將之轉置後才成為縱向排列
謝謝指導
作者: Andy2483    時間: 2021-9-16 15:07

回復 16# ML089


    前輩好
1.請教上傳範例中的不重複日期陣列如何排序
2.請您指導陣列的觀念與語法.結構..等是否有錯或執行效率如何提升
3.執行結果將用於呈現統計圖表
陣列觀念懵懵懂懂,請前輩們指導
作者: ML089    時間: 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有點怪怪的，我自己也在摸索中也跟大家一樣相互觀摩學習。
作者: ML089    時間: 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
作者: ML089    時間: 2021-9-16 17:28

回復 18# Andy2483

你問題若與此版問題無關，最好另外開版詢問比較好。
作者: Andy2483    時間: 2021-9-17 07:32

回復 19# ML089


   謝謝前輩指導
一腦門的想學陣列,想在陣列裡排序再做統計
忘了結果貼到表裡再排序

您太客氣了,前輩們都很厲害又很熱心
謝謝
作者: Andy2483    時間: 2021-9-17 07:40

回復 20# ML089


    謝謝前輩指導
今天接到一個重要又急的程式要開發
您的指導我再撥空研究

勉強跟這主題沾上邊!能解惑就好!
以後若找不到相關主題再另開主題請教
謝謝
作者: Andy2483    時間: 2022-10-25 13:47

回復 20# ML089

謝謝前輩指導
後學最近學習字典與陣列,有看懂前輩的指導!
很汗顏的是後學學了十幾年!今天才懂即時運算視窗怎麼用!
謝謝
[attach]35397[/attach]



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