返回列表 上一主題 發帖

[發問] 如何以vba編寫程式將A欄不順序並重覆的資料各抽一個出來順序存放於B欄

pcwh3

帖子
51 
主題
14 
精華
0 
積分
143 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-5-11 
最後登錄
2023-5-8 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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
收藏 分享

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-15 

熱烈參與勳章
7#
發表於 2015-10-2 21:05 | 只看該作者
http://blog.xuite.net/hcm19522/twblog/346607668
函數 參考即可

TOP

pcwh3

帖子
51 
主題
14 
精華
0 
積分
143 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-5-11 
最後登錄
2023-5-8 
6#
發表於 2015-9-29 20:47 | 只看該作者
多謝准提大大指點。
我現用的版本程式都是將資料放在另一工作紙上, 再copy and paste回資料工作紙中的正確位置。
所提的程式經改動一下，放入本人現用的程式中，己可做到一氣呵成的功能，省郤了借助先放到另一工作紙中再copy and paste回去的工序。
多謝指點。

TOP

准提部林

帖子
2833 
主題
10 
精華
0 
積分
2889 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-15 
5#
發表於 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
複製代碼

TOP

pcwh3

帖子
51 
主題
14 
精華
0 
積分
143 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-5-11 
最後登錄
2023-5-8 
4#
發表於 2015-9-29 19:44 | 只看該作者
我所提出的A 欄和B 欄只是方便提問，但實際上真正運作的檔案相關資料不是在A 欄，A 欄前還有很多資料。
A 欄的資料是不可删除的。不然的話會影響後逐的資料抽取。
只能將A 欄的資料提取存於B 欄待用。

TOP

koo

帖子
60 
主題
4 
精華
0 
積分
64 
點名
0  
作業系統
w7-32 
軟體版本
2013.2003 
閱讀權限
20 
註冊時間
2014-11-23 
最後登錄
2016-6-6 
3#
發表於 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
複製代碼

TOP

koo

帖子
60 
主題
4 
精華
0 
積分
64 
點名
0  
作業系統
w7-32 
軟體版本
2013.2003 
閱讀權限
20 
註冊時間
2014-11-23 
最後登錄
2016-6-6 
2#
發表於 2015-9-29 17:49 | 只看該作者
新版就使用"資料--移除重複"然後針對該欄做排序就可以
在B欄都輸入1然後用合併彙算功能也可以辦到
插入樞紐分析表也可以整理

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題