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

Lani 发表于 Dev

拉尼

按照我的问题描述：我有一个可变列长的表。我想在第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完全相同的代码也可以工作。安妮对此有帮助吗？提前致谢！！

马丁·德雷尔（Martin Dreher）

虽然适当的解决方案可能会重做大多数代码，并且可能会在代码中争论变量名和固定值，但我认为这可能不会一步一步地为您提供帮助。

因此，对于初学者，我建议以下内容（如果您是VBA的新手）：

首先，我会改变

maxValue = Application.Max(searchArea)

对此

maxValue = Application.WorksheetFunction.Max(searchArea)

然后用

rowMax = Application.WorksheetFunction.Match(maxValue, searchArea, 0)

（您可以将其嵌套）

笔记：

仅当第4列（您的搜索区域）中只有不同的值时，这才起作用。否则情况可能会变得更加复杂，可以通过首先对数据进行排序而将其忽略掉
在这种情况下，rowmax将在搜索范围内返回目标行。
由于“ searchrange”从修订8开始，因此您可以执行“ rowmax = awf.match + 8” ...也就是说，如果之后选择不使用searchArea-Range

编辑：试试这个。就像我说的那样，虽然这种方法可以说有点可怕，但我认为从学习的角度来看，最好保持目前为止所做的一切，而仅将其更改为“以某种方式起作用”。希望对您有所帮助！

Sub TestMax()

Dim searchArea As Range

Dim rowMax As Long
Dim maxValue As Long

Dim lastRow As Long

columnSearch = 4

'get the lastrow
lastRow = Sheets("V&A 16").Range("B1048576").End(xlUp).Row

'set the search area
Set searchArea = Range(Cells(8, columnSearch), Cells(lastRow, columnSearch))

'Find the row that contains the max value inside the search area
rowMax = Application.WorksheetFunction.Match( _
    Application.WorksheetFunction.Max(searchArea), searchArea, 0)

'clumsily copy+paste (alternative: set values instead of copying)
'searchArea.Cells(rowMax, columnSearch).EntireRow.Copy
'Cells(6, columnSearch).EntireRow.Select
'ActiveSheet.Paste

' Alternative:
ActiveSheet.Rows(6).Cells().Value = searchArea.Rows(rowMax).EntireRow.Cells.Value
End Sub