很大的Excel工作表中的VBA頻率熒光筆功能

Question

在以前的帖子用戶中：LocEngineer設法幫助我編寫了一個查找功能，該功能可以在特定類別的列中查找頻率最低的值。

VBA代碼在大多數情況下可以解決某些特定問題，並且先前的問題已經得到了足夠好的回答，因此我認為這需要新的帖子。

LocEngineer：“棒極了，蝙蝠俠！如果那真的是你的床單。...我會說：忘記“ UsedRange”。那在THAT傳播中效果不佳...我已經使用更多硬編碼的值。請根據您的需要調整值，然后嘗試嘗試。哇，真是一團糟。”

這是代碼：

Sub frequenz()
Dim col As Range, cel As Range
Dim letter As String
Dim lookFor As String
Dim frequency As Long, totalRows As Long
Dim relFrequency As Double
Dim RAN As Range

RAN = ActiveSheet.Range("A6:FS126")
totalRows = 120

For Each col In RAN.Columns
    '***get column letter***
    letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)
    '*******
    For Each cel In col.Cells
        lookFor = cel.Text
        frequency = Application.WorksheetFunction.CountIf(Range(letter & "2:" & letter & totalRows), lookFor)
        relFrequency = frequency / totalRows

        If relFrequency <= 0.001 Then
            cel.Interior.Color = ColorConstants.vbYellow
        End If
    Next cel

Next col

End Sub

代碼的格式如下：（請注意，合並的單元格位於標題的每一列。標題下降到第5行，數據從第5行開始）（還請注意，行中的空列非常多，有時更多比數據。）

最后，我不知道的一個重要更改是如何使它忽略空白單元格。 請指教。 謝謝。

Answer 1

如果要進行2次調整，請執行以下操作：1.排除標題，並2.保留空白單元格

1. 以更動態的方式排除標題； 這不包括前6行：

---

With ActiveSheet.UsedRange
    Set ran = .Offset(6, 0).Resize(.Rows.Count - 6, .Columns.Count)
End With

---

2. 在內部For循環中，在此行之后， For Each cel In col.Cells您需要一個IF：

---

For Each cel In col.Cells
    If Len(cel.Value2) > 0 Then...

---

這是修改后的版本（未試用）：

---

Option Explicit

Sub frequenz()
    Const MIN_ROW   As Long = 6
    Const MAX_ROW   As Long = 120

    Dim col As Range
    Dim cel As Range
    Dim rng As Range

    Dim letter      As String
    Dim lookFor     As String
    Dim frequency   As Long

    With ActiveSheet.UsedRange
        Set rng = .Offset(MIN_ROW, 0).Resize(MAX_ROW, GetMaxCell.Column)
    End With

    For Each col In rng.Columns
        letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)

        For Each cel In col
            lookFor = cel.Value2

            If Len(lookFor) > 0 Then    'process non empty values
                frequency = WorksheetFunction.CountIf( _
                                Range(letter & "2:" & letter & MAX_ROW), lookFor)

                If frequency / MAX_ROW <= 0.001 Then
                    cel.Interior.Color = ColorConstants.vbYellow
                End If
            End If
        Next cel
    Next col
End Sub

---

。

更新以在確定包含值的最后一行和列時使用新功能：

---

Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range

    'It returns the last cell of range with data, or A1 if Worksheet is empty

    Const NONEMPTY As String = "*"
    Dim lRow As Range, lCol As Range

    If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange

    If WorksheetFunction.CountA(rng) = 0 Then
        Set GetMaxCell = rng.Parent.Cells(1, 1)
    Else
        With rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByRows)
            Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByColumns)
            Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
        End With
    End If
End Function

---