excel VBA：在多列中查找最大值和最小值，在另一列中查找最小值的匹配项，然后粘贴到新工作表中

我正在进行VBA的第一步。我正在编写一个代码，检索列C（target1）的最大值和最小值以及列A（target2）中对应于最小值的值，并将它们粘贴到新工作表中。应使用作为目标1重复此操作：F栏和目标2：列D，等等。我已经写了一个代码（见下文），工作，但我相信一定有一个更干净和直接的方法来解决这个问题，也许与数组和循环。有人能帮助我吗？提前感谢

`Sub FindMinMax()
 
 Dim minVal As Variant
 Dim maxVal As Variant
 Dim minValInColA As Variant
 
 ' Set the named sheet and the target column
 Dim namedSheet As Worksheet
 Set namedSheet = Sheets("Wells_A")
 Dim tgcol1, tgcol2, tgcol3 As String
 tgcol1 = "C"
 tgcol2 = "F"
 tgcol3 = "I"
 
 ' Find the minimum and maximum values in the target column C
 minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol1 & ":" & tgcol1))
 maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol1 & ":" & tgcol1))

 ' Find the minimum value in column A that corresponds to the minimum value in the target column
 minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("A:A"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol1 & ":" & tgcol1), 0), 1)
 
' Paste the minimum and maximum values in the first column of the new sheet
Sheets("final").Range("B3").Value = minValInColA
Sheets("final").Range("C3").Value = minVal
Sheets("final").Range("D3").Value = maxVal

' Find the minimum and maximum values in the target column F
minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol2 & ":" & tgcol2))
maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol2 & ":" & tgcol2))
 
' Find the minimum value in column D that corresponds to the minimum value in the target column
 minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("D:D"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol2 & ":" & tgcol2), 0), 1)

' Paste the minimum and maximum values in the first column of the new sheet
 Sheets("final").Range("B4").Value = minValInColA
Sheets("final").Range("C4").Value = minVal
Sheets("final").Range("D4").Value = maxVal

' Find the minimum and maximum values in the target column F
minVal = Application.WorksheetFunction.Min(namedSheet.Range(tgcol3 & ":" & tgcol3))
maxVal = Application.WorksheetFunction.Max(namedSheet.Range(tgcol3 & ":" & tgcol3))

' Find the minimum value in column G that corresponds to the minimum value in the target column
minValInColA = Application.WorksheetFunction.Index(namedSheet.Range("G:G"), Application.WorksheetFunction.Match(minVal, namedSheet.Range(tgcol3 & ":" & tgcol3), 0), 1)
 
' Paste the minimum and maximum values in the first column of the new sheet
Sheets("final").Range("B5").Value = minValInColA
Sheets("final").Range("C5").Value = minVal
Sheets("final").Range("D5").Value = maxVal

End Sub`

您是正确的，使用数组将大大缩短代码（尽管在性能上没有明显的差异）。
然而，从代码看起来，你好像是在3列中工作，每隔3列（C, F, I是第3列、第6列和第9列）搜索一列，并返回前两列的对应值。所以，你甚至不需要像数组这样具体的东西，只需要使用Step 3循环来查看每隔3列。
我的建议是：

Sub MinMaxCondensed()
Dim shtFrom As Worksheet, shtTo As Worksheet 'Source and Destination worksheets
Set shtFrom = Sheets("Wells_A"): Set shtTo = Sheets("final")
Dim lCol as Long 'Column variable

With Application.WorksheetFunction
    For lCol = 3 to 9 Step 3
        shtTo.Range("B" & lCol/3 + 2) = .Index(shtFrom.Columns(lCol-2), .Match(.Min(shtFrom.Columns(lCol)), shtFrom.Columns(lCol))
        shtTo.Range("C" & lCol/3 + 2) = .Min(shtFrom.Columns(lCol))
        shtTo.Range("D" & lCol/3 + 2) = .Max(shtFrom.Columns(lCol))
    Next
End With 'Application.WorksheetFunction
End Sub

这样，如果您需要进一步查看shtFrom，只需在循环中增加to值即可。

excel VBA：在多列中查找最大值和最小值，在另一列中查找最小值的匹配项，然后粘贴到新工作表中

1条答案

相关问题

热门标签

最新问答