Board logo

標題: [發問] 如何以vba編寫程式將A欄不順序並重覆的資料各抽一個出來順序存放於B欄 [打印本頁]
作者: pcwh3    時間: 2015-9-29 16:34     標題: 如何以vba編寫程式將A欄不順序並重覆的資料各抽一個出來順序存放於B欄

有一大堆(數以千項)重覆雜亂及不順序的資料存放於A欄，我要如何利用VBA在A欄中各抽取一個單一的資料並順序排列於B欄中？

資料                              結果
HK01150923-3        HK01150923-1
HK01150923-3        HK01150923-2
HK01150923-1        HK01150923-3
HK01150924-1        HK01150924-1
HK01150923-2        HK01150924-2
HK02150923-2        HK02150923-2
HK02150923-3        HK02150923-3
HK01150923-1        HK02150925-1
HK01150923-1        HK02150925-2
HK01150923-1        HK02150925-3
HK01150923-2       
HK01150923-2       
HK01150924-2       
HK01150924-1       
HK02150925-2       
HK02150923-3       
HK01150924-1       
HK01150923-2       
HK01150924-1       
HK02150925-1       
HK02150925-3       
HK01150923-3       
HK02150925-3       
HK02150925-2
作者: koo    時間: 2015-9-29 17:49

新版就使用"資料--移除重複"然後針對該欄做排序就可以
在B欄都輸入1然後用合併彙算功能也可以辦到
插入樞紐分析表也可以整理

[attach]22115[/attach]
作者: koo    時間: 2015-9-29 18:09

本帖最後由 koo 於 2015-9-29 18:11 編輯

小的只會初淺的寫法
複製到B欄後計算超過1個就砍掉
最後請做B欄排序就可以
  1. Sub test()
  2. Columns("A:A").Copy Cells(1, 2)
  3.     For i = [B65536].End(xlUp).Row To 1 Step -1
  4.         Rx = Application.CountIf([B:B], Range("B" & i))
  5.         If Rx > 1 Then Cells(i, 2).Delete Shift:=xlUp
  6.     Next
  7. End Sub
複製代碼
作者: pcwh3    時間: 2015-9-29 19:44

我所提出的A 欄和B 欄只是方便提問，但實際上真正運作的檔案相關資料不是在A 欄，A 欄前還有很多資料。
A 欄的資料是不可删除的。不然的話會影響後逐的資料抽取。
只能將A 欄的資料提取存於B 欄待用。
作者: 准提部林    時間: 2015-9-29 20:08

取出不重覆唯一值並排序，這是基本語法，論壇找一下有很多相關資料，
因是基本語法，不想再一直重覆作說明，儲存格參照及資料所在欄位，請自行依實際修改！
  1. Sub TEST()
  2. Dim Arr, AA, xD, N&
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. For Each AA In Range([Sheet1!A1], [Sheet1!A65536].End(xlUp)).Value
  5. 　　If Mid(AA, 3, 10) Like "########-#" Then xD(AA) = ""
  6. Next
  7. 　
  8. N = xD.Count:　　If N = 0 Then Exit Sub
  9. [Sheet2!A:A].ClearContents
  10. With [Sheet2!A1].Resize(N)
  11. 　　.Value = Application.Transpose(xD.keys)
  12. 　　.Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
  13. End With
  14. End Sub
複製代碼
作者: pcwh3    時間: 2015-9-29 20:47

多謝准提大大指點。
我現用的版本程式都是將資料放在另一工作紙上, 再copy and paste回資料工作紙中的正確位置。
所提的程式經改動一下，放入本人現用的程式中，己可做到一氣呵成的功能，省郤了借助先放到另一工作紙中再copy and paste回去的工序。
多謝指點。
作者: hcm19522    時間: 2015-10-2 21:05

http://blog.xuite.net/hcm19522/twblog/346607668
函數 參考即可



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