Question

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

VBA代码在很大程度上适用于某些特定问题，之前的问题已经得到了足够好的答案，所以我认为这需要一个新的帖子。

LocEngineer：＆＃34;神圣的吸烟，蝙蝠侠！如果那真的是你的表......我会说：忘记＆＃34; UsedRange＆＃34;。这传播得不够好......我已经使用更多硬编码的值编辑了上面的代码。请根据您的需要调整值，然后尝试。哇哇哇哇。＆＃34;

以下是代码：

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行开始）（另请注意，行中充满了空列，有时比数据更多。） enter image description here

最后，我无法弄清楚的一个重要变化是如何让它忽略空白单元格。请指教。谢谢。

Answer 1

如果要进行的2次调整是1.排除标题，并且2.空白单元格

以更动态的方式排除标题;这排除了前6行：

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

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

非常大的Excel表格中的VBA频率突出显示功能

1 个答案: