- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
14#
發表於 2023-12-1 09:46
| 只看該作者
本帖最後由 Andy2483 於 2023-12-1 15:56 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA,學習方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, i&, R&, N&, T$, T1$
'↑宣告變數
Brr = Range([C1], [B65536].End(xlUp))
'↑令Brr變數是裝入儲存格值的二維陣列
ReDim Crr(1 To 1000, 1 To 2)
'↑宣告Crr變數是二維空陣列,宣告其所引號範圍
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2 到 Brr陣列縱向最大列號
R = Val(Brr(i, 1)): T1 = Trim(Brr(i, 2))
'↑令R變數是 迴圈列1欄陣列值轉成的數值(週數)
'令T1變數是 迴圈列2欄陣列值去除前後空白字元後的新字串(內容)
If R = 0 Or T1 = "" Then GoTo i01 Else Crr(R, 1) = R
'↑如果序號或內容是空的 !就跳過,否則令結果陣列Crr第1欄週數列寫入週數
If InStr(T & "/", "/" & T1 & "/") Then GoTo i01 Else N = IIf(N < R, R, N)
'↑如果串接內容的字串裡有這 T1變數內容!就跳過,
'否則令N變數記錄結果陣列需要用多少列
Crr(R, 2) = IIf(Crr(R, 2) = "", T1, Crr(R, 2) & ":" & T1)
'↑令結果陣列Crr第2欄內容列寫入沒有重複的內容
T = T & "/" & T1
'↑令T變數累串接T1變數(內容)
i01: Next
[H:I].ClearContents
'↑令舊的結果儲存格資料清除內容
If N = 0 Then Exit Sub
'↑如果N變數是0(沒有符合的資料)!就結束程式執行
[H3].Resize(N, 2) = Crr
'↑令所需要的結果儲存格區域寫入Crr陣列值
End Sub |
|
發表於 2021-9-8 15:19
| 