[發問] (字典物件)查詢並對齊資料列問題

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

2^#

發表於 2016-11-11 15:21 | 只看該作者

真的很抱歉,
"原始資料"分頁跟
"期望結果示意"分頁的A欄跟B欄應該是完全一樣的,
"期望結果示意"分頁的第19橫列是多打的,而第一空白橫列應予刪除而未刪除,
造成困擾不好意思.

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

3^#

發表於 2016-11-12 08:40 | 只看該作者

回復 2# greetingsfromtw

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

複製代碼

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

4^#

發表於 2016-11-12 09:11 | 只看該作者

回復 3# c_c_lai

十分感謝c_c_lai前輩提供解答,小弟再研究一下

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

5^#

發表於 2016-11-12 10:13 | 只看該作者

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

複製代碼

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

6^#

發表於 2016-11-13 21:27 | 只看該作者

回復 5# 准提部林

非常感謝淮提部林前輩願意費心指點,一直以來承蒙前輩無私指導,真的非常感激.
再次感謝.

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

7^#

發表於 2016-11-15 21:48 | 只看該作者

回復 5# 准提部林

淮提部林前輩您好,不好意思冒昧問一下,

前輩所提供程式碼的其他部份小弟勉強能領會一二,

只是關於第三行:
Arr = Range("A2:F" & [A65536].End(3).Row)

其中數字3這個部份,小弟不明其意,
雖然知道可取代xlUP,但是用1,2,4去修改程式碼進行試驗,卻無法達到取代xlToRight等其他方向的效果,
而是變成選取整欄或是整列,
小弟斗膽,懇請前輩不吝指點,感謝.

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

8^#

發表於 2016-11-15 22:24 | 只看該作者

回復 7# greetingsfromtw

不習慣用數字, 就用原來熟用的就好, 不須煩這個!
由下而上, 起點就要取下方的儲存格往上找,
由上而下, 起點就相反,
左/右方向亦同, 多參幾次, 做到懂為止!

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

9^#

發表於 2016-11-15 22:54 | 只看該作者

回復 8# 准提部林

了解,十分感謝前輩指點,小弟會再努力練習.

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

10^#

發表於 2023-5-11 14:12 | 只看該作者

回復 5# 准提部林

謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導

資料表:

結果表:

Sub TEST()
Dim Arr, D, T$, R&, C&
'↑宣告變數
Arr = Range("A2:F" & [A65536].End(3).Row)
'↑令Arr變數是二維陣列,以儲存格值帶入陣列裡
Set D = CreateObject("Scripting.Dictionary")
'↑令D變數是字典
For C = 1 To UBound(Arr, 2) Step 2
'↑設順迴圈跑欄!每繞回一次 +2 (1,3,5,.....)
For R = 1 To UBound(Arr)
'↑設順迴圈跑列!
      T = Arr(R, C): If T = "" Then GoTo 101
      '↑令T變數是迴圈的Arr陣列值
      '如果T變數是空字元!就跳到101標示位置繼續執行(空白不處理)
      If C = 1 Then D(T) = R: GoTo 101
      '↑如果C變數是1!就令以T變數當key,item是R變數(索引列號),
      '跳到101標示位置繼續執行
      Arr(R, C) = "": Arr(R, C + 1) = ""
      '↑令處理過的陣列位置清除
      '(因為用同一陣列放原資料調整為新資料)
      Arr(D(T), C) = T
      '↑令T變數查D字典得item值列第C變數欄Arr陣列值是 T變數
      Arr(D(T), C + 1) = Arr(D(T), 2)
      '↑令右側欄Arr陣列值是Arr陣列第2欄值
101: Next
Next
[期望結果示意!A3:F3].Resize(UBound(Arr)) = Arr
'↑令Arr陣列值寫入另一個工作表
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流