非常大的 Excel 工作表中的 VBA 频率荧光笔功能

Question

在之前的帖子中，用户：LocEngineer 设法帮助我编写了一个查找函数，该函数将在特定类别的列中查找最不频繁的值。

VBA 代码在大多数情况下都能很好地解决一些特定问题，并且之前的问题已经得到了足够好的答案，所以我认为这需要一个新帖子。

LocEngineer：“天哪，蝙蝠侠！如果那真的是你的床单……我会说：忘记“UsedRange”。这不会很好地传播……我已经编辑了上面的代码使用了更多硬编码的值。请根据您的需要调整值并尝试。哇，真是一团糟。”

代码如下：

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

---

1. 在内部 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

---