Matchfunction在VBA中

我有一个函数返回第三个最低值。 它跳过空白,但包括0,这正是我想要的。 当我在工作表上定期(或作为一个数组)使用公式时,它是有效的。 但是相同的function在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 

解决……最后!

 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 

我试过这个,如果值来自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数组,我认为这将取决于你如何引用空值。 我使用了一个空string,仍然有效,你需要一个变种arrays

 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,空,空,空,空,空}