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

以下是我的问题描述： 我有一个可变列长度的表。我想在第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的代码完全相同。有什么帮助吗？提前谢谢

您可以在第4列中循环查找对应于最小值的行，并将该行复制到第6行

（示例：考虑要检查的10000行数据）

Sub-Foo（）
最小=单元格（1，4）。值
i=1
对于i=2到10000
如果单元格（i，4）.Value<最小，单元格（i，4）.Value为“”，则
最小=单元格（i，4）。值
行=i
如果结束
接下来我
行（行和“：”&行）。选择
选择，复制
行（“6:6”）。选择
活动表。粘贴
端接头

虽然一个合适的解决方案可能会重做大部分代码，并且可能会对代码中的变量名和固定值产生争议，但我觉得这可能无助于逐步解决问题

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

首先，我会改变

maxValue = Application.Max(searchArea)

对此

maxValue = Application.WorksheetFunction.Max(searchArea)

然后，使用

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

（你可以把它收藏起来）

注:

• 只有在第4列（您的搜索区域）中只有不同的值时，这才有效。否则事情可能会变得更复杂一些，通过先对数据进行排序可以大大忽略这一点
• 在这种情况下，rowmax将返回搜索范围内的targetrow
• 由于“searchrange”从修复8开始，您可以执行“rowmax=awf.match+8”。。。也就是说，如果您选择以后不使用searchArea范围

编辑： 试试这个。正如我所说的，虽然这种方法可能有点可怕，但我认为从学习的角度来看，最好保持你迄今为止所做的，只是将其改为“以某种方式起作用”。希望有帮助

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

---

请尝试

WorksheetFunction.Min（Range）

+1，因为这对于初学者来说是一种相当干净的方法-即使awf函数与完整循环相比速度相当快。谢谢您的帮助。当我按照您的建议应用更改时，我得到了一个错误：“无法获取WorksheetFunction类的Match属性”我如何更改它？尝试保留您迄今为止所做的大部分工作，只避免搜索、选择、复制和粘贴（这在暂停程序或处理多个工作表时很容易出错甚至有害）

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