Excel 如何查找最小值，选择相应的值，将这些值复制并粘贴到新图纸上

下面是我的问题描述

      A    B    C    D     
   1  H1   H2   H3   H4   
   2  1    3    4    2      
   3  2    4    1    8     
   4  3    1    6    1       
   5  4    2    8    5           

第一行有标题。列A具有表的序列号。列B、C和D是一些计算得出的值。我想编写一个VBA代码，以便代码在列D中找到最小值，选择行的所有对应值，仅复制和粘贴名为NewSheet的工作表中的值

对于上述给定情况，VBA代码应确定单元格D4具有最小值，它应选择第4行中的相应值（来自单元格B4、C4和D4），复制这些选定值并将值粘贴到“新闻纸”的单元格P2、Q2和R2中

---

由于我只是一个初学者，如果响应者能提供一些有助于我理解代码的注释，我将不胜感激

这样就可以了

Option Explicit ' Forces you to declare variables. Helps prevent stupid mistakes.

Sub Rabbit()

' Declare variables. Can also spread this throughout your code...
Dim rngData As Range
Dim rngTarget As Range
Dim varData As Variant
Dim iCounter As Long
Dim iMinH4 As Long
Dim dblMinH4 As Double
Dim shtNew As Worksheet

' Where to get the data from (H1...H4 headers not included here)
Set rngData = Worksheets("Sheet1").Range("A2").Resize(4, 4)

' Get all data from sheet at once. Faster than interrogating sheet multiple times.
varData = rngData

' Get first entry. This is the minimum so far, by definition...
iMinH4 = 1
dblMinH4 = varData(1, 4)
' Go through all other entries to see which is minimum.
For iCounter = LBound(varData, 1) +1 To UBound(varData, 1) ' +1 since first entry already checked
    If varData(iCounter, 4) < dblMinH4 Then
        ' This is the minimum so far.
        dblMinH4 = varData(iCounter, 4)
        iMinH4 = iCounter
    Else
        ' This is not the minimum.
        ' Do nothing.
    End If
Next iCounter

' If creating new sheet is necessary, uncomment this:
'Set shtNew = ActiveWorkbook.Worksheets.Add
'shtNew.Name = "NewSheet"

' Where should the values go?
Set shtNew = ActiveWorkbook.Worksheets("NewSheet")
Set rngTarget = shtNew.Range("P2:R2")

' Copy the values over to NewSheet.
rngData.Cells(iMinH4, 1).Resize(1, 3).Copy rngTarget

End Sub

optionexplicit'强制您声明变量。有助于防止愚蠢的错误。
亚兔（）
'声明变量。也可以将其传播到整个代码中。。。
暗rngData As范围
变光目标As范围
变量数据作为变量
暗淡的i计数器
将imiminh4变长
双精度dblMinH4
Dim shtNew As工作表
'从何处获取数据（此处不包括H1…H4标头）
设置rngData=工作表（“图纸1”）。范围（“A2”）。调整大小（4，4）
'立即从工作表中获取所有数据。比审讯表快很多倍。
varData=rngData
“第一个进入。根据定义，这是迄今为止的最低值。。。
亚胺4=1
dblMinH4=varData（1,4）
'检查所有其他条目，看看哪一个是最小值。
对于iCounter=LBound（varData，1）+1到UBound（varData，1）“+1，因为已选中第一个条目
如果varData（iCounter，4）

这行吗

通过编写一个函数，根据列标题返回指定工作表中的列，可以改进此宏。这样就不必硬编码列号4和16

Dim newSheet As Worksheet
Dim yourWorksheet As Worksheet
Dim searchArea As Range
Dim searchResult As Range
Dim yourWorkbook As String
Dim rowMinimum As Long
Dim minimumValue As Long
Dim columnSearch As Integer
Dim columnNew As Integer

columnSearch = 4
columnNew = 16

yourWorkbook = [workbook name]

Set yourWorksheet = Workbooks(yourWorkbook).Worksheets([worksheet name])
Set newSheet = Workbooks(yourWorkbook).Worksheets("NewSheet")

'Select all the cells in the column you want to search down to the first empty
'cell.
Set searchArea = yourWorksheet.Range(yourWorksheet.Cells(2, columnSearch), _
yourWorksheet.Cells(yourWorksheet.Cells(2, columnSearch).End(xlDown).Row, _
columnSearch))

'Determine the minimum value in the column.
minimumValue = Application.Min(searchArea)

'Find the row that contains the minimum value.
Set searchResult = yourWorksheet.Columns(columnSearch).Find(What:=minimumValue, _
After:=yourWorksheet.Cells(1, columnSearch), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

'Store the row that contains the minimum value in a variable.
rowMinimum = searchResult.Cells.Row

'Copy the other cells in the row containing the minimum value to the new
'worksheet.
yourWorksheet.Range(yourWorksheet.Cells(rowMinimum, 1), _
yourWorksheet.Cells(rowMinimum, columnSearch - 1)).Copy _
Destination:=newSheet.Cells(2, columnNew)

---

嘿，谢谢Strcompnice。。。。。我将以某种方式使用你的代码。。。所以我想对你说声谢谢……：-）没问题。在Excel中测试宏时，我发现了一些错误，因此我更新了代码。@strcompnice我在包含以下内容的代码中遇到了错误：“yourWorkbook=[workbook name]Set yourWorkbook=工作簿（yourWorkbook）。工作表（[workbook name]）Set newSheet=工作簿（yourWorkbook）。工作表（“newSheet”）”虽然我试图将我的工作表命名为DynamicCarray2，但我无法运行代码。有什么建议可以让它运行吗？您的工作簿应该包含工作簿的名称。例如，如果工作簿的名称是TableData.xls，那么代码应该是yourWorkbook=“TableData.xls”。每个工作表的名称可以在Excel窗口底部的选项卡中找到。因此，如果包含数据的工作表的名称为DynamicArray2，则应将代码设置为yourWorksheet=Workbooks（yourWorkbook）。工作表（“DynamicArray2”）。@strcompnice，非常感谢。。。。我非常理解你的代码，并且在我的工作中使用了经过修改的代码。。。。非常感谢你的帮助。。。最美好的祝福。。。乔希