获得大于零的最低值

时间:2016-10-08 09:05:42

标签: excel vba excel-vba

我有上面的代码,它从列中找到五个最大值。 我需要做同样的事情,但最小值高于零。 我需要它在VBA中,因为用户可以在工作表之后更改值。

我已经将max更改为min,但是会出错。

Sub best()

Dim maxvalue As Long
Dim copyrow As Long

copyrow = 30
Dim prevval As Long
Dim prevrow As Long
Dim i As Long
Dim fndrow As Long

prevval = 0
prevrow = 0

For i = 1 To 5

    maxvalue = WorksheetFunction.Large(Sheets("Resumo").Range("J11:J47"), i)
    If maxvalue <> prevval Then
        fndrow = Sheets("Resumo").Range("J11:J47").Find(What:=maxvalue, LookIn:=xlValues, lookat:=xlWhole).Row
    Else
        fndrow = Sheets("Resumo").Range("J" & prevrow & ":J47").Find(What:=maxvalue, LookIn:=xlValues, lookat:=xlWhole).Row
    End If

    Dim vendor As String

    vendor = Sheets("Resumo").Range("G" & CStr(fndrow))

    Sheets("os melhores").Range("F" & CStr(copyrow)) = maxvalue
    If InStr(vendor, " ") <> 0 Then
        Sheets("os melhores").Range("G" & CStr(copyrow)) = Left(vendor, InStr(vendor, " "))
        Sheets("os melhores").Range("H" & CStr(copyrow)) = Right(vendor, InStr(vendor, " "))
    Else
        Sheets("os melhores").Range("G" & CStr(copyrow)) = Sheets("Resumo").Range("G" & CStr(fndrow))
    End If

    prevval = maxvalue
    prevrow = fndrow

    copyrow = copyrow + 1
Next i

End Sub

File 提前致谢

3 个答案:

答案 0 :(得分:2)

您无需使用宏来解决此问题或关于前5的原始问题。您可以使用array formula

请参阅此屏幕截图以供参考:

enter image description here

设定:

  • A1:A7有数据,您需要使用您的范围进行更新
  • C2具有C3
  • 中的公式
  • C3:C7具有前5个最大值
  • D2具有D3
  • 中的公式
  • D3:D7的前5个小值大于0

以Max为例,将公式放入单元格C3并按Enter键。然后,您将获得最大的数字。从那里突出显示单元格C3并按下向下移动4次,以突出显示接下来的4行。然后进入公式栏并单击要编辑的公式。从那里按ctrl + shift + enter(PC)命令+输入(苹果,我认为),它将填写剩余的单元格。当您更改参考范围中的值时,它们将更新。

以下是制作数组公式应该是什么样子的屏幕截图:

enter image description here

如您所见,具有公式的单元格是具有焦点的主要单元格,而下一个4单元格被突出显示。光标位于公式框中,然后按ctrl + shift + enter。

次要更新:

你甚至不需要一个数组公式来解决最大的5.您可以将每个excel设置为LARGE(A1:A7,1),然后将下一个单元格设置为LARGE(A1:A7,2),然后是下一个单元格如大(A1:A7,3)等。

答案 1 :(得分:1)

你可以试试这个:

Option Explicit

Sub best()
    Dim copyrow As Long
    Dim helpRng  As Range

    copyrow = 30
    With Worksheets("Resumo")
        With .Range("J11:J47")
            Set helpRng = .Offset(, .Parent.UsedRange.Columns.Count)
            helpRng.Value = .Value
            helpRng.Offset(, 1).Value = .Offset(, -7).Value
            Set helpRng = helpRng.Resize(.Rows.Count + 1, 2).Offset(-1)
        End With
    End With

    With helpRng
        .Cells(1, 1).Resize(, 2) = "header"
        .Sort key1:=helpRng, order1:=xlAscending, Header:=xlYes
        .AutoFilter field:=1, Criteria1:=">0"
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
            Worksheets("os melhores").Cells(copyrow, "F").Resize(5, 2).Value = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Resize(5).Value
            Worksheets("os melhores").Cells(copyrow, "G").Resize(5).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True
        End If
        .Parent.AutoFilterMode = False
        .ClearContents
    End With
End Sub

并将order1:=xlAscending更改为order1:=xlDescending以使“os melhores”工作表中的前五个最高值报告

答案 2 :(得分:0)

基于代码,我认为错误是由于如果你将WorksheetFunction.Large更改为WorksheetFunction.Small(你做了,对吧?)那么maxvalue可以是0,所以0不是专用的'无效值'了。您可以执行以下操作之一:

  1. 将maxvalue声明为variant并使用不同的值表示无效,例如“不适用”,检查第一个If中是否有maxvalue。

  2. (这也有助于过滤掉0和负值)WorksheetFunction.Large的第一个参数应该是另一个排除负值(或非正值)的工作表函数,就像你在式:

    = IF(0

  3. 编写一个算法,将值和行号存储到固定大小的数组中。