(字典物件)查詢並對齊資料列問題
各位前輩好,小弟目前練習字典物件時遇到一個問題,
附上檔案以供前輩參考:
[attach]25761[/attach]
問題以文字簡單說明如下:
A欄與B欄為資料總表,依序排列,
A欄儲存格資料與B欄儲存格資料具有相對關係.
C欄與D欄的資料是取自A欄B欄,但是順序經過打亂.
E欄與F欄亦同.
現在是希望可以將資料排序後,將資料的橫列位置對齊A欄與B欄的位置.
用文字說明可能不易理解,
還請前輩參考附檔的"期望結果示意"頁籤.
這個練習問題是改編自以下網址的實例7:
http://club.excelhome.net/thread-868892-1-1.htmlz
該論壇有板友附上參考解答如下,
我用電腦版看不到網站的圖片,
推測可能是從第三橫列開始,與小弟此篇的附檔有些差異,僅供參考:[code]Private Sub CommandButton1_Click() ‘by:oobird
Dim d As Object, rng, i%, j%, arr
Set d = CreateObject("Scripting.Dictionary")
rng = Range("a3:f" & [a65536].End(xlUp).Row)
ReDim arr(1 To UBound(rng), 1 To 4)
For i = 1 To UBound(rng)
d(CStr(rng(i, 1))) = i
Next i
For j = 3 To 5 Step 2
For i = 1 To Cells(65536, j).End(xlUp).Row - 2
If d(CStr(rng(i, j))) <> "" Then
arr(d(CStr(rng(i, j))), j - 2) = rng(i, j)
arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1)
End If
Next i
Next j
[c3].Resize(UBound(rng), 4) = arr
End Sub [/code]因為知道論壇上的前輩應該有其他方式的解法,
所以小弟斗膽上來發問,可以的話還望前輩不吝解答,感謝. 真的很抱歉,
"原始資料"分頁跟
"期望結果示意"分頁的A欄跟B欄應該是完全一樣的,
"期望結果示意"分頁的第19橫列是多打的,而第一空白橫列應予刪除而未刪除,
造成困擾不好意思. [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95408&ptid=18722]2#[/url] [i]greetingsfromtw[/i] [/b]
[attach]25763[/attach][code]Sub Ex2()
Dim arr As Variant, cts As Integer
Dim ln As Integer, cn As Integer
With Sheets("原始資料")
cts = Application.CountA(.Range("A:A"))
ReDim arr(1 To cts - 1, 1 To 4)
For ln = 2 To cts
For cn = 3 To 5 Step 2
If .Cells(ln, cn) <> "" Then
arr(Asc(.Cells(ln, cn).Value) - 64, cn - 2) = .Cells(ln, cn)
arr(Asc(.Cells(ln, cn).Value) - 64, cn - 1) = .Cells(ln, cn + 1)
End If
Next cn
Next ln
.[G2].Resize(cts - 1, 4) = arr
End With
End Sub
[/code] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95422&ptid=18722]3#[/url] [i]c_c_lai[/i] [/b]
十分感謝c_c_lai前輩提供解答,小弟再研究一下 [code]Sub TEST()
Dim Arr, D, T$, R&, C&
Arr = Range("A2:F" & [A65536].End(3).Row)
Set D = CreateObject("Scripting.Dictionary")
For C = 1 To UBound(Arr, 2) Step 2
For R = 1 To UBound(Arr)
T = Arr(R, C): If T = "" Then GoTo 101
If C = 1 Then D(T) = R: GoTo 101
Arr(R, C) = "": Arr(R, C + 1) = ""
Arr(D(T), C) = T
Arr(D(T), C + 1) = Arr(D(T), 2)
101: Next
Next
[期望結果示意!A3:F3].Resize(UBound(Arr)) = Arr
End Sub
[/code] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95424&ptid=18722]5#[/url] [i]准提部林[/i] [/b]
非常感謝淮提部林前輩願意費心指點,一直以來承蒙前輩無私指導,真的非常感激.
再次感謝. [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95424&ptid=18722]5#[/url] [i]准提部林[/i] [/b]
淮提部林前輩您好,不好意思冒昧問一下,
前輩所提供程式碼的其他部份小弟勉強能領會一二,
只是關於第三行:
Arr = Range("A2:F" & [A65536].End(3).Row)
其中數字3這個部份,小弟不明其意,
雖然知道可取代xlUP,但是用1,2,4去修改程式碼進行試驗,卻無法達到取代xlToRight等其他方向的效果,
而是變成選取整欄或是整列,
小弟斗膽,懇請前輩不吝指點,感謝. [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95507&ptid=18722]7#[/url] [i]greetingsfromtw[/i] [/b]
不習慣用數字, 就用原來熟用的就好, 不須煩這個!
由下而上, 起點就要取下方的儲存格往上找,
由上而下, 起點就相反,
左/右方向亦同, 多參幾次, 做到懂為止! [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95508&ptid=18722]8#[/url] [i]准提部林[/i] [/b]
了解,十分感謝前輩指點,小弟會再努力練習. [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=95424&ptid=18722]5#[/url] [i]准提部林[/i] [/b]
謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導
資料表:
[attach]36339[/attach]
結果表:
[attach]36340[/attach]
Sub TEST()
Dim Arr, D, T$, R&, C&
[color=SeaGreen]'↑宣告變數[/color]
Arr = Range("A2:F" & [A65536].End(3).Row)
[color=SeaGreen]'↑令Arr變數是二維陣列,以儲存格值帶入陣列裡[/color]
Set D = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令D變數是字典[/color]
For C = 1 To UBound(Arr, 2) Step 2
[color=SeaGreen]'↑設順迴圈跑欄!每繞回一次 +2 (1,3,5,.....)[/color]
For R = 1 To UBound(Arr)
[color=SeaGreen] '↑設順迴圈跑列![/color]
T = Arr(R, C): If T = "" Then GoTo 101
[color=SeaGreen] '↑令T變數是迴圈的Arr陣列值
'如果T變數是空字元!就跳到101標示位置繼續執行(空白不處理)[/color]
If C = 1 Then D(T) = R: GoTo 101
[color=SeaGreen] '↑如果C變數是1!就令以T變數當key,item是R變數(索引列號),
'跳到101標示位置繼續執行[/color]
Arr(R, C) = "": Arr(R, C + 1) = ""
[color=SeaGreen] '↑令處理過的陣列位置清除
'(因為用同一陣列放原資料調整為新資料)[/color]
Arr(D(T), C) = T
[color=SeaGreen] '↑令T變數查D字典得item值列第C變數欄Arr陣列值是 T變數[/color]
Arr(D(T), C + 1) = Arr(D(T), 2)
[color=SeaGreen] '↑令右側欄Arr陣列值是Arr陣列第2欄值[/color]
101: Next
Next
[期望結果示意!A3:F3].Resize(UBound(Arr)) = Arr
[color=SeaGreen]'↑令Arr陣列值寫入另一個工作表[/color]
End Sub
頁:
[1]