關於A欄是否可以判斷相同序號後將B欄合併並保留原始數據 - Excel程式區

　暱稱: 厚臉皮的學生

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

1^# 跳轉到 »

發表於 2023-5-4 09:46 | 顯示全部帖子

回復 1# killer77107

謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考

執行前:

執行結果:

Option Explicit
Sub TEST()
Dim Brr, Y, i&, T$, P$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = [需求說明1!A1].CurrentRegion: Brr = xR
For i = 2 To UBound(Brr)
P = Brr(i, 1)
T = Switch((T <> P) * (P <> ""), P, P = "", T)
If T = "" Then GoTo i01
Y(T) = Replace(Trim(Y(T) & " " & Brr(i, 2)), " ", vbLf)
i01: Next
[J1] = "=A1": [K1] = "=B1"
[J2].Resize(Y.Count, 1) = Application.Transpose(Y.keys)
[K2].Resize(Y.Count, 1) = Application.Transpose(Y.items)
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

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

　暱稱: 厚臉皮的學生

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

2^#

發表於 2023-5-4 10:40 | 顯示全部帖子

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,練習不使用keys轉置結果,而以結果資料覆蓋原陣列資料,再將結果寫入儲存格,學習方案如下,請各位前輩指教

Option Explicit
Sub TEST_1()
Dim Brr, Y, i&, R&, T$, P$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = [需求說明1!A1].CurrentRegion: Brr = xR
For i = 2 To UBound(Brr)
P = Brr(i, 1)
T = Switch((T <> P) * (P <> ""), P, P = "", T)
If T = "" Then GoTo i01
If Y(T) = "" Then
Y(T) = Y.Count + 1: Brr(Y(T), 1) = T: Brr(Y(T), 2) = Brr(i, 2): GoTo i01
End If
R = Y(T): Brr(R, 2) = Replace(Trim(Brr(R, 2) & " " & Brr(i, 2)), " ", vbLf)
i01: Next
[J1].Resize(Y.Count + 1, 2) = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

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

　暱稱: 厚臉皮的學生

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

3^#

發表於 2023-5-4 16:28 | 顯示全部帖子

回復 6# 准提部林

謝謝前輩指導不用字典的方法

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

　暱稱: 厚臉皮的學生

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

4^#

發表於 2023-5-8 13:20 | 顯示全部帖子

回復 6# 准提部林
回復 8# killer77107

謝謝兩位前輩
後學藉此帖學習准提部林前輩的方案,學習心得註解如下,請前輩指教

Option Explicit
Sub 合併_01()
Dim Arr, i&, N&
'↑宣告變數
Arr = Range([a1], [b65536].End(3))
'↑令Arr是二維陣列,以儲存格值帶入陣列裡
For i = 2 To UBound(Arr)
'↑設順迴圈
If Arr(i, 1) <> "" Then
'↑如果序號不是空白?
   N = N + 1
   '↑令N變數累加1
   Arr(N + 1, 1) = Arr(i, 1)
   '↑令序號值帶入Arr陣列第1欄指定的索引列號位置
   Arr(N + 1, 2) = Arr(i, 2)
   '↑令材料值帶入Arr陣列第2欄指定的索引列號位置
Else
'↑否則
   Arr(N + 1, 2) = Arr(N + 1, 2) & Chr(10) & Arr(i, 2)
   '↑令材料值帶入Arr陣列第2欄指定的索引列號位置值跳行的後面
End If
Next i
[e:f].ClearContents
'↑令清除舊結果欄內容
[e1:f1].Resize(N + 1, 2) = Arr
'↑令局部的Arr陣列值帶入儲存格中
End Sub

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