我有一个返回第三个最低值的函数。它跳过空白但包含0,这正是我想要的。当我在工作表上定期(或作为数组)使用公式时,它可以工作。但是同样的功能在VBA中不起作用。
Example:
=MATCH(SMALL(E3:O3,3),E3:O3,FALSE) in the worksheet does the following
{1,2,3,blank,5} returns the value 3
{1,2,3,0,5} returns the value 2
wf.Match(wf.Small(aDivs, i), aDivs, False) in VBA does the following
{1,2,3,blank,5} returns the value 2
{1,2,3,0,5} returns the value 2
(aDivs is a calculation stored in an array)
以前工作正常,但因为现在有可能非顺序地填充单元格,我需要这部分来跳过空白。如何让VBA函数像工作表函数一样工作?任何帮助将不胜感激。谢谢!
以下是代码:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim vaNums As Variant, vaDenoms As Variant, aDivs() As Double
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 - 1)
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
答案 0 :(得分:0)
我试过这个,如果值来自Excel范围,它可以工作:
Function GetSmall3(ByRef MyRange As Range)
Dim v, x, y
v = MyRange
x = Application.Small(v, 3)
y = Application.Match(x, v, 0)
GetSmall3 = y
End Function
如果您正在使用excel数组,我认为这取决于您如何引用空值。 我使用了一个空字符串仍然可以工作,你需要一个变种数组
Dim v, x, y
v = Array(1, 2, 3, "", 5)
x = Application.Small(v, 3)
y = Application.Match(x, v, 0)
msgbox y
这与您上一个代码相似并且有效
Sub Try()
Dim i As Integer, vanums, aDivs, rRow, wf
Dim lSmall
Set wf = Application.WorksheetFunction
Set rRow = Range("A1:J1")
vanums = rRow
ReDim aDivs(LBound(vanums, 2) To UBound(vanums, 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)
End If
Next i
For i = 1 To 3
lSmall = wf.Match(wf.Small(aDivs, i), aDivs, False)
MsgBox lSmall
Next
End Sub
A1中的值:J1 {1,2,3,空,5,空,空,空,空,空}
答案 1 :(得分:0)
...解决最后!!!
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
Dim lRows As Integer
Dim lCols As Long
Set wf = Application.WorksheetFunction
lCols = Range(Cells(1, 5), Cells(1, 5).Offset(0, ActiveSheet.ListObjects(1).ListColumns.Count - 11)).Count
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, lCols)
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)
If IsEmpty(vaNums(1, i)) Then
aDivs(i) = Empty
Else
aDivs(i) = vaNums(1, i) / vaDenoms(1, i) + (i / 10000)
End If
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