工作表计算忽略空白 - VBA

Question

有人帮忙！这让我抓狂！我需要仅从具有vaNums值的单元格中找到最低的三个计算值。我需要vaNums / vaDenoms。从该计算中找到三个最低值，但仅来自具有vaNums值的单元格。如果零在vaNums中，则可以将其包括为三个最低值之一。如果vaNums为空，则不应将其包含为三者之一。示例：0/20 = 0（可以作为三个最低之一）空白/ 20 = 0（不能作为三个最低之一）请帮忙！

Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim i As Long
Dim vaNums As Variant, vaDenoms As Variant, aDivs() As Variant
Dim wf As WorksheetFunction
Dim lSmall As Long
Dim rRow As Range
Dim rStart As Range
Dim iCount As Integer
Const lCols As Long = 10
Const lMarkcnt As Long = 3
Set wf = Application.WorksheetFunction
Set rRow = target.Cells(1).Offset(0, 1).Resize(1, lCols)
Set rStart = Me.Cells(1, 5)
iCount = wf.CountA(rRow, ">0")
If Not Intersect(target.Cells(1), Me.Range("D3", Me.Range("D3").End(xlDown))) Is Nothing Then
If iCount > 4 Then
    Set rRow = target.Cells(1).Offset(0, 1).Resize(1, iCount)
    rStart.Resize(1, lCols).Interior.ColorIndex = xlNone
    rStart.Resize(1, lCols).Font.ColorIndex = xlAutomatic
    vaNums = rRow.Value
    vaDenoms = rStart.Offset(1, 0).Resize(1, lCols).Value
    ReDim aDivs(LBound(vaNums, 2) To UBound(vaNums, 2))
    For i = LBound(vaNums, 2) To UBound(vaNums, 2)
        aDivs(i) = vaNums(1, i) / vaDenoms(1, i) + (i / 10000)
    Next i
    For i = 1 To 3
        lSmall = wf.Match(wf.Small(aDivs, i), aDivs, False)
        rStart.Offset(0, lSmall - 1).Interior.Color = 6299648
        rStart.Offset(0, lSmall - 1).Font.ThemeColor = xlThemeColorDark1
    Next i
Else
    rStart.Resize(1, lCols).Interior.ColorIndex = xlNone
    rStart.Resize(1, lCols).Font.ColorIndex = xlAutomatic
End If
Else
rStart.Resize(1, lCols).Interior.ColorIndex = xlNone
rStart.Resize(1, lCols).Font.ColorIndex = xlAutomatic
End If

End Sub

Answer 1

  

忽略空白的工作表计算 - VBA

     

我只需要从具有vaNums值的单元格中找到最低的三个计算值。

     

如果vaNums为空，则不应将其作为三者之一。

如果我理解正确的话，那不是很简单吗？使用.SpecialCells。它返回一个Range对象，该对象表示与指定类型和值匹配的所有单元格。

语法

expression.SpecialCells（Type，Value）

在内置帮助中阅读有关它的更多信息。

假设您的范围为A1:D10

只需使用此

即可

Sub Sample()
    Dim rng As Range, aCell As Range
    Dim MyAr As Variant
    Dim i As Long

    '~~> Change worksheet name and range as applicable
    With ThisWorkbook.Sheets("Sheet2").Range("A1:D10")
        On Error Resume Next
        Set rng = .SpecialCells(xlCellTypeConstants)
        On Error GoTo 0

        If rng Is Nothing Then Exit Sub

        ReDim MyAr(1 To rng.Cells.Count)

        i = 1

        For Each aCell In rng
            MyAr(i) = aCell.Value
            i = i + 1
        Next

        For i = LBound(MyAr) To UBound(MyAr)
            Debug.Print MyAr(i)
        Next
    End With
End Sub

<强>截图：

Answer 2

这是我需要的代码部分。希望除了更广泛的背景之外，这是有道理的：

For i = LBound(vaNums, 2) To UBound(vaNums, 2)
    If IsEmpty(vaNums(1, i)) Then
        aDivs(i) = Empty
    Else
        aDivs(i) = vaNums(1, i) / vaDenoms(1, i) + (i / 10000)
    End If
Next I

我发布的第一个代码是另一个代码。我只需要调整它。感谢所有帮助过的人！