- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
3#
發表於 2023-12-28 11:54
| 只看該作者
回復 1# cypd
謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習到篩選後的儲存格範圍帶入陣列中會有資料中斷不全的問題,後學藉此帖學習了.SpecialCells(xlCellTypeVisible)方法,學習方案如下,請前輩參考
執行結果:
Option Explicit
Sub TEST()
Dim xU As Range, Crr, A As Range, Z, T$, T1$, T2$, R&, N&, i&, j%
Set Z = CreateObject("Scripting.Dictionary")
Set xU = Range([C2], [C65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
ReDim Crr(1 To 10000, 1 To 3)
For Each A In xU: Z(Trim(A)) = Z(Trim(A)) + 1: Next
For Each A In xU
T1 = Trim(A): T2 = Trim(A(1, 2)): T = T1 & "|" & T2
If Z(T1) = 1 Or T1 = "" Then GoTo i01 Else R = Z(T)
If R = 0 Then N = N + 1: R = N: Z(T) = R: Crr(R, 1) = "'" & T1: Crr(R, 2) = T2
Crr(R, 3) = Crr(R, 3) + 1
i01: Next
If N = 0 Then Exit Sub
With Workbooks.Add.Sheets(1)
.[A1].Resize(1, 3) = [{"關鍵字1","關鍵字2","次數"}]
.[A2].Resize(N, 3) = Crr
.Columns(1).EntireColumn.AutoFit
.Cells.Sort KEY1:=.Cells(1), Order1:=1, Key2:=.Cells(2), Order2:=1, Header:=1
For i = 2 To .[A65536].End(3).Row
j = j - (.Cells(i, 1) <> .Cells(i - 1, 1))
.Cells(i, 1).Interior.ColorIndex = j Mod 15 + 33
Next
End With
End Sub |
|
