- 帖子
- 185
- 主題
- 47
- 精華
- 0
- 積分
- 227
- 點名
- 0
- 作業系統
- WIN 7
- 軟體版本
- 旗舰版
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-9-14
- 最後登錄
- 2024-11-19
|
13#
發表於 2024-1-30 03:23
| 只看該作者
我試用lastChar = Right(Tr(1), 1)來存儲當前匹配鍵的最後一個字符,然後檢查下一個單元格的內容與lastChar不同, 才開始繼續在L列向下檢查,但仍然不成功- Sub Test_A1()
- Dim Arr, A, Brr, xD, i&, j&, T$, Tr, R, lastChar$
- Set xD = CreateObject("Scripting.Dictionary") '創建一個字典對象
- '遍歷一個數組，並將每個元素按"\"分割，然後將分割後的第二部分作為鍵，第一部分作為值存入字典
- For Each A In Array("1^12\優優良", "2^10\良良優", "3^3\優優優", "4^3\良良良", _
- "5^3\優良", "6^3\良優", "7^-3\優優", "8^-10\良良")
- Tr = Split(A, "\")
- xD(Tr(1)) = Tr(0)
- Next A
- '讀取Excel工作表中的一個範圍到Arr數組，然後根據Arr的大小重新定義Brr數組
- Arr = Range([L1], [L65536].End(xlUp)(5))
- ReDim Brr(1 To UBound(Arr), 0)
- '關閉屏幕更新，以提高代碼執行速度
- Application.ScreenUpdating = False
- '遍歷Arr數組，並根據字典中的條目對Excel工作表中的某些單元格進行格式化
- For i = 2 To UBound(Arr) - 4
- T = Arr(i, 1)
- If T <> Arr(i - 1, 1) Then
- For j = i + 1 To i + 2
- T = T & Arr(j, 1)
- R = xD(T)
- If R <> "" Then
- Tr = Split(R, "^")
- lastChar = Right(Tr(1), 1)
- If Arr(j + 1, 1) <> lastChar Then
- With Range("L" & i & ":L" & j)
- .BorderAround 1
- .Interior.ColorIndex = Cells(Tr(0) + 2, 1).Interior.ColorIndex
- End With
- Brr(j - 1, 0) = Tr(1): i = j: Exit For
- End If
- End If
- Next j
- End If
- Next i
- '將Brr數組的內容寫入Excel工作表的一個範圍
- [o2].Resize(UBound(Brr)) = Brr
- End Sub
|
|
發表於 2024-1-29 16:14
| 
