我正在尋找一個 VBA 程式，它允許在 excel 的一個單元格中對多個整數值進行顏色排序。例如，如果小于 10 的數字為紅色，則介于 10-20 之間的數字為綠色，大于 20 的數字為黃色。但是，兩個整數值可以放在一個單元格中，因此兩個數字可能在該單元格內具有不同的顏色。請幫忙。謝謝。
uj5u.com熱心網友回復：
您沒有回答我的最后一個澄清問題......上述解決方案假設每個數字的最大位數（它們可能多于兩個）是3。數字必須用任何分隔符分隔。涉及括號之間的第二個數字的模式也包括在內。它還假設要處理的范圍在“A:A”列中。該代碼可以很容易地適應任何列：
Sub ColorNubersFontConditionaly()
Dim sh As Worksheet, lastR As Long, arr, strVal As String, necCol As Long, i As Long, j As Long, nbPos As Long
Set sh = ActiveSheet 'use here your necessary worksheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last filled cell in column A:A
For i = 2 To lastR 'iterate between the range cells
nbPos = 1: strVal = sh.Range("A" & i).Value 'place the cell value in a string
arr = extrAllNumb(strVal) 'the array of extracted numbers
If IsArray(arr) Then
For j = 0 To UBound(arr) 'process each extracted number and color it according the mentioned conditions
nbPos = InStr(nbPos, strVal, arr(j), vbTextCompare)
If CLng(arr(j)) < 10 Then
necCol = vbRed
ElseIf CLng(arr(j)) >= 10 And CLng(arr(j)) <= 20 Then
necCol = vbGreen
Else
necCol = vbYellow
End If
sh.Range("A" & i).Characters(nbPos, Len(arr(j))).Font.Color = necCol
nbPos = nbPos Len(arr(j))
Next j
End If
Next i
End Sub
Private Function extrAllNumb(strVal As String) As Variant 'it return an array containing all numbers having between 1 and 3 digits
Dim Res As Object, El, arr, i As Long
With CreateObject("VBScript.RegExp")
.Pattern = "(\d{1,3})"
.Global = True
If .test(strVal) Then
Set Res = .Execute(strVal)
ReDim arr(Res.count - 1)
For Each El In Res
arr(i) = El: i = i 1
Next
End If
End With
extrAllNumb = arr
End Function
...
Please, send some feedback after testing the code.
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/504377.html