我有上面的代码,它从列中找到五个最大值。 我需要做同样的事情,但最小值高于零。 我需要它在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 提前致谢
答案 0 :(得分:2)
您无需使用宏来解决此问题或关于前5的原始问题。您可以使用array formula。
请参阅此屏幕截图以供参考:
设定:
以Max为例,将公式放入单元格C3并按Enter键。然后,您将获得最大的数字。从那里突出显示单元格C3并按下向下移动4次,以突出显示接下来的4行。然后进入公式栏并单击要编辑的公式。从那里按ctrl + shift + enter(PC)命令+输入(苹果,我认为),它将填写剩余的单元格。当您更改参考范围中的值时,它们将更新。
以下是制作数组公式应该是什么样子的屏幕截图:
如您所见,具有公式的单元格是具有焦点的主要单元格,而下一个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)