- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2024-3-27 14:06 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
Option Explicit
Sub 不重複各欄明細()
Dim Brr, Crr, Z, Q, i&, j%, R&, T$, x%, Rm&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect([主頁!B17].CurrentRegion, [主頁!B17:P65536])
ReDim Crr(10000, 1 To UBound(Brr, 2))
For j = 1 To UBound(Brr, 2)
For i = 2 To UBound(Brr)
Q = Split(Brr(i, j) & Chr(10), Chr(10))
For x = 0 To UBound(Q) - 1
T = Trim(Q(x))
If Not Z.Exists(T) And T <> "" Then R = R + 1: Crr(R, j) = T: Z(T) = "": Rm = IIf(R > Rm, R, Rm)
Next
Next
Crr(0, j) = Brr(1, j): R = 0: Z.RemoveAll
Next
Workbooks.Add
With [A1].Resize(Rm + 1, UBound(Brr, 2))
.NumberFormat = "@": .Value = Crr: .EntireColumn.AutoFit
For j = 1 To UBound(Brr, 2): .Columns(j).Sort KEY1:=.Cells(1, j), Order1:=1, Header:=1: Next
End With
End Sub |
|
發表於 2024-3-27 11:03
| 
