Question

关注我的问题描述：我有一个变长列长度的表。我想在第4列中搜索最小值，然后将最小值的行复制到第6行

这是我的代码：

Sub TestMax()

Dim searchArea As Range
Dim searchResult As Range
Dim rowMax As Long
Dim maxValue As Long
Dim columnSearch As Integer
Dim lastRow As Long

columnSearch = 4

'Select all the cells in the column you want to search down to the first empty cell.
lastRow = Sheets("V&A 16").Range("B1048576").End(xlUp).Row
Range(Cells(8, 4), Cells(lastRow, 4)).Select
Set searchArea = Range(Cells(8, 4), Cells(lastRow, 4))

'Determine the max value in the column.
maxValue = Application.Max(searchArea)

'Find the row that contains the max value.
Set searchResult = Sheets("V&A   16").Columns(columnSearch).Find(What:=maxValue, _
After:=Sheets("V&A 16").Cells(8, columnSearch), LookIn:=xlValues,     LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)


'Store the row that contains the minimum value in a variable.
rowMax = searchResult.Cells.Row
searchResult.Select
Range(Cells(rowMax, 3), Cells(rowMax, 13)).Select
Selection.Copy
Range("C6").Select
ActiveSheet.Paste Link:=True

End Sub

由于某些原因，我一直收到错误。与Application.Min完全相同的代码而不是max工作。安妮帮忙吗？在此先感谢!!

Answer 1

您可以遍历第4列以找到与最小值对应的行，并将该行复制到第6行

（例如：考虑10,000行要检查的数据）

Sub Foo()

smallest = Cells(1, 4).Value
i = 1

For i = 2 To 10000
    If Cells(i, 4).Value < smallest And Cells(i, 4).Value <> "" Then
        smallest = Cells(i, 4).Value
        Row = i
    End If
Next i

Rows(Row & ":" & Row).Select
Selection.Copy
Rows("6:6").Select
ActiveSheet.Paste

End Sub

在列中找到最大值，选择相应的值，复制并粘贴值

1 个答案: