我有原始数据的“表1”。行数和列数总是不同的。列显示温度随时间变化的函数。如图所示：
ColumnA（时间）0.000 / B栏（TC1）27.342 / C栏（TC2）26.409 / D栏（TC3）......等
我想在每个温度列中找到最大值，然后将它们复制并粘贴到“sheet2”上，粘贴它的第一行，并将峰值温度与其行匹配，如下所示：
TC1 305.387（最大值）354（行）/ TC2 409.989（最大值）575（行）/ TC3 789.383（最大温度）899（行）......等。
关键是我正在使用我自己的范围...每次我使用代码时我选择不同的范围，有时包括所有行和一些列，其他时候包括一些行和所有列等。下面是myRange代码：
Public Sub run_CalcPeakTemp()
Dim myCalRange As Range
Dim iReply As Integer
On Error Resume Next
Set myCalcRange = Application.InputBox(Prompt:="Select first row and then Ctrl+Shift+down", Title:="Select Range", Type:=8)
myCalcRange.Select
If myCalcRange Is Nothing Then
iReply = MsgBox("Range not selected!")
Exit Sub
If myCalcRange Is notNothing Then
Call run_CalcPeakTemp
End If
End If
这就是我被困住的地方......我无法在循环中做到这一点。我做得非常基本......一步一步......我是初学者:(
Dim VarMaxVal As Variant
VarMaxVal = 0
VarMaxVal = Application.WorksheetFunction.Max(Columns(1))
Sheets("Calc").Select
Range("A1").Select
ActiveCell.Offset(1, 2).Range("A1").Select
ActiveCell.FormulaR1C1 = VarMaxVal
其他栏目等等。
.....虚空我能够复制所选动态范围的第一行。
答案 0 :(得分：0)
这不是＆＃34;这样做，一切都会好的＆＃34;回答是因为我不太明白你在尝试什么。但是，我希望这个答案包含足够的指针，供您创建所需的代码。
第1期
当存在合适的工作表函数时，使用工作表函数而不是自己的VBA是绝对正确的，因为工作表函数将大大加快。但是，如果有任何方法可以让Max函数返回行，我不知道。我相信您必须使用VBA扫描每一列。
第2期
不应该像这样使用 On Error Resume Next，因为所有错误都将被忽略。理想情况下，您可以提前检查以避免错误。如果要打开文件，则应在尝试打开之前检查它是否存在，而不是等待打开失败并给出错误。但是，在某些情况下您无法检查错误。在这种情况下，您可以使用On Error Resume Next所以：
Err.Clear
On Error Resume Next
' Statement that might fail
On Error GoTo 0
If Err.Number <> 0 Then
' Statement failed.
' Description of failure in Err.Description.
' Report error with user friendly message and exit or take corrective action.
End If
第3期
请缩进您的代码，以便更容易阅读和发现错误。例如：
1 Public Sub run_CalcPeakTemp()
2 Dim myCalRange As Range
3 Dim iReply As Integer
4 'On Error Resume Next
5 Set myCalcRange = Application.InputBox(Prompt:="Select first row and then Ctrl+Shift+down", _
6 Title:="Select Range", Type:=8)
7 myCalcRange.Select
8 If myCalcRange Is Nothing Then
9 iReply = MsgBox("Range not selected!")
10 Exit Sub
11 If myCalcRange Is notNothing Then
12 Call run_CalcPeakTemp
13 End If
14 End If
15 End Sub
我添加了行号，以便我可以轻松引用语句。我还将第5行分成两行，因此大部分都是可见的。
第4期
在第2行，您声明myCalRange。在例程中的其他地方，您使用myCalcRange。如果模块的第一个语句是Option Explicit，则在编译时会告诉您myCalcRange尚未声明。如果省略Option Explicit，则对myCalcRange的第一次引用将执行隐式声明。检测隐式声明可能非常困难。始终包含Option Explicit。
第5期
第11行应为If Not myCalcRange Is Nothing Then。 VBA没有IsNot运算符，空格位置错误。
第6期
我从未以这种方式使用过InputBox，而且我觉得这有助于误导：
设置myRange = Application.InputBox（提示：=＆＃34;示例＆＃34;，输入：= 8）
如果您不使用Set语句，则将变量设置为范围中的值，而不是Range对象本身。
如果myRange被声明为Range，那么Set是强制性的。如果myRange被声明为Variant，则Set被禁止。如果未声明myRange，并且您依赖于隐式声明，那么如果您包含myRange，则Range将被声明为Set，如果您省略Variant它
这不是你的错。 VBA的这个功能（？）至少有11年的历史，我只能假设有人认为他们有帮助。
第7期
7 myCalcRange.Select
8 If myCalcRange Is Nothing Then
您无法选择Nothing范围。必须先进行测试。
第8期
8 If myCalcRange Is Nothing Then
9 iReply = MsgBox("Range not selected!")
10 Exit Sub
11 If myCalcRange Is notNothing Then
12 Call run_CalcPeakTemp
13 End If
14 End If
通过缩进，您可以看到所有这些代码都在第一个If内。我不确定这是不是你想要的。你的意思是？
8 If myCalcRange Is Nothing Then
9 iReply = MsgBox("Range not selected!")
10 Exit Sub
14 End If
11 If myCalcRange Is notNothing Then
12 Call run_CalcPeakTemp
13 End If
我假设你试图强迫用户选择一个范围。通常，您应该允许用户以某种方式取消选择。理论上，要强制用户进行选择，您需要以下内容：
Set myCalcRange = Nothing
Do While myCalcRange Is Nothing
Set myCalcRange = Application.InputBox ...
Loop
实际上，InputBox不允许用户单击确定，除非已选择范围并单击取消给出VBA错误。 InputBox( ... type := 8)不是我用过的声明！
第9期
12 Call run_CalcPeakTemp
一个例程调用本身称为递归，并且VBA允许它，但它不能以这种方式使用。一种可能的用法是向下搜索层次结构并获取底部的值。例程检查是否位于层次结构的底部。如果是，则返回该值。如果不是，它会调用自己的下一级作为参数。
这是VBA相当于我多年前教过的简单使用递归：
Function Factorial(ByVal N As Long) As Long
If N = 1 Then
Factorial = 1
Else
Factorial = N * Factorial(N - 1)
End If
End Function
这个例程：
Sub Test()
Debug.Print "Factorial(1) = " & Factorial(1)
Debug.Print "Factorial(2) = " & Factorial(2)
Debug.Print "Factorial(3) = " & Factorial(3)
Debug.Print "Factorial(4) = " & Factorial(4)
Debug.Print "Factorial(5) = " & Factorial(5)
End Sub
在即时窗口中显示以下内容：
Factorial(1) = 1
Factorial(2) = 2
Factorial(3) = 6
Factorial(4) = 24
Factorial(5) = 120
某些可能有用的代码
此代码符合我对您的要求的猜测。
我对我使用的VBA的语法几乎没有提及。一般来说，一旦你知道一个陈述存在，就很容易查找，但是如果有必要的话就会问。
我试过解释了我在做什么。我试图使我的代码尽可能通用和可维护。这里有很多，但如果你慢慢地对代码工作，我相信你会掌握每个部分正在做的事情。如有必要，再次询问。
我认为学习编程就像学习驾驶汽车一样。在第一课结束时，您知道在检查镜子时，您将永远无法使用三个踏板，一个齿轮杆，一个轮子和一个指示器。然而一个月之后，你不记得为什么你发现它如此困难。欢迎来到编程的乐趣。我希望你能像我一样有趣。
Sub ExtractMaxTemperatures()
' I understand your temperatures are in columns 2 to 5. If I use these values
' in the code and they change (perhaps because new columns are added) then you
' will have to search the code for the appropriate 2s and 5s and replace them.
' Constants allow me to use names which makes the code easier to understand.
' Also if the column numbers change, change the constants and the code is fixed.
' I have used Sheet1 to hold the full set of temperatures and Sheet2 to hold the
' extracted maximums. In these constants, and in the variables below, replacing
' "Sht1" and "Sht2" with something more meaningful will help make the code more
' readable.
Const ColSht1TempFirst As Long = 2
Const ColSht1TempLast As Long = 5
Const RowSht1DataFirst As Long = 3
Const ColSht2Dest As Long = 2
Const RowSht2Dest As Long = 3
Dim ColSht1Crnt As Long
Dim RowSht1Crnt As Long
Dim ColSht2Crnt As Long
Dim RowSht2Crnt As Long
' Declare fixed size arrays to hold the maximum temperature
' and its row for each column
Dim TempMaxByCol(ColSht1TempFirst To ColSht1TempLast) As Single
Dim RowForMaxTemp(ColSht1TempFirst To ColSht1TempLast) As Long
Dim TempCrnt As Single
Dim TempMaxCrnt As Single
Dim RowForMaxCrnt As Long
Dim ShtValue As Variant
' It is possible to check the values within the worksheet with statements
' such as "If .Cells(RowCrnt, ColCrnt).Value = 5 Then"
' However, it is much quicker to copy all values from the worksheet to an
' array and process the values from the array. I have done this since I
' will have to use arrays within the column loop.
' I do not know the name of the worksheet containing the temperatue so I have
' used Sheet1.
' The statement "ShtValues = .UsedRange.Value" converts ShtValues to a two
' dimensional array containing every value in in the worksheet. The rows
' are dimension 1 and the columns are dimension 2 which is not the usual
' arrangement. However, it means "ShtValue(RowCrnt, ColCrnt)" matches
' ".Cells(RowCrnt, ColCrnt).Value" which avoids confusion.
' Because I have loaded the entire worksheet, row and column numbers within
' the array will match those in the worksheet.
With Worksheets("Sheet1")
ShtValue = .UsedRange.Value
End With
' Loop for each temperature column
For ColSht1Crnt = ColSht1TempFirst To ColSht1TempLast
' Your code assume no blank or non-numeric values within the temperature
' ranges. However, were they to exist, the code would fail so I check.
RowForMaxCrnt = 0 ' Indicates no temperature saved yet
' Loop for each data row column. UBound(ShtValue, 2) identifies the last row.
For RowSht1Crnt = RowSht1DataFirst To UBound(ShtValue, 1)
If IsNumeric(ShtValue(RowSht1Crnt, ColSht1Crnt)) Then
' This cell is numeric
TempCrnt = Val(ShtValue(RowSht1Crnt, ColSht1Crnt))
If RowForMaxCrnt <> 0 Then
' A possible maximum temperature has already been stored.
' Check current value against it.
If TempMaxCrnt < TempCrnt Then
' Higher temperature found. Store details in temporary variables
RowForMaxCrnt = RowSht1Crnt
TempMaxCrnt = TempCrnt
End If
Else
' First temperature found. Store details in temporary variables
RowForMaxCrnt = RowSht1Crnt
TempMaxCrnt = TempCrnt
End If
End If
Next
'Store values in temporary variable in arrays
TempMaxByCol(ColSht1Crnt) = TempMaxCrnt
RowForMaxTemp(ColSht1Crnt) = RowForMaxCrnt
Next
' Initialise the current row to the start row of the outout table
RowSht2Crnt = RowSht2Dest
' I think you call the destination sheet "Calc" but I have used "Sheet2"
With Worksheets("Sheet2")
' Create header lines
' TC1 TC2 TC3 TC4
' Max Row Max Row Max Row Max Row
' This code will handle multiple header rows
For RowSht1Crnt = 1 To RowSht1DataFirst - 1
ColSht2Crnt = ColSht2Dest
For ColSht1Crnt = ColSht1TempFirst To ColSht1TempLast
' Merge two cells together ready for column name
.Range(.Cells(RowSht2Crnt, ColSht2Crnt), _
.Cells(RowSht2Crnt, ColSht2Crnt + 1)).Merge
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = ShtValue(RowSht1Crnt, ColSht1Crnt)
.HorizontalAlignment = xlCenter
End With
ColSht2Crnt = ColSht2Crnt + 2
Next
RowSht2Crnt = RowSht2Crnt + 1
Next
' Now add "Max Row Max Row Max Row Max Row" row
ColSht2Crnt = ColSht2Dest
For ColSht1Crnt = ColSht1TempFirst To ColSht1TempLast
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = "Max"
.HorizontalAlignment = xlRight
End With
ColSht2Crnt = ColSht2Crnt + 1
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = "Row"
.HorizontalAlignment = xlRight
End With
ColSht2Crnt = ColSht2Crnt + 1
Next
RowSht2Crnt = RowSht2Crnt + 1
' Now create data row
ColSht2Crnt = ColSht2Dest
For ColSht1Crnt = ColSht1TempFirst To ColSht1TempLast
.Cells(RowSht2Crnt, ColSht2Crnt).Value = TempMaxByCol(ColSht1Crnt)
ColSht2Crnt = ColSht2Crnt + 1
.Cells(RowSht2Crnt, ColSht2Crnt).Value = RowForMaxTemp(ColSht1Crnt)
ColSht2Crnt = ColSht2Crnt + 1
Next
End With
End Sub
修改添加，因为OP想要选择要从中选择最大值的列。
如果我理解你的评论：
上面的代码将处理任意数量的行。我建议你保持不变，即使你认为这个数字总是30岁。在我的职业生涯中，我听说过＃34;这个要求永远不会改变＆＃34;很多次只听到一两年后＃34;抱歉，它已经改变了。＆＃34;
上面的代码有一个方面，我认为它很弱，但我不想纠正，因为它会增加不想解释的复杂性。我使用.UsedRange从工作表加载数据。这是最简单的方法，但.UsedRange的定义并不总是与用户期望的相匹配。 .UsedRange包括已格式化的行和列（例如，高度或宽度已更改）但未使用。在此answer of mine 到之前的问题中，我包含一个宏，该宏演示了许多用于查找最终行或列的技术，并显示了每个方法失败的位置。我不认为这对您当前的问题很重要，但我建议您保存该宏并稍后进行实验。
考虑这个宏：
Sub TestGetRange()
Dim CalcRange As Range
Dim Reply As Long
Do While True
Err.Clear
On Error Resume Next
Set CalcRange = Application.InputBox(Prompt:="Select columns to be copied", _
Title:="Extract maximum temperatures", Type:=8)
On Error GoTo 0
If Err.Number <> 0 Then
Reply = MsgBox(Prompt:="Do you wish to exit without extracting any temperatures?", _
Buttons:=vbYesNo, Title:="Extract maximum temperatures")
If Reply = vbYes Then
' User wants to exit
Exit Do
End If
' Loop for another go
Else
' User had entered a valid range
Exit Do
End If
Loop
If CalcRange Is Nothing Then
Debug.Print "User wants immediate exit"
Exit Sub
Else
Debug.Print CalcRange.Address
End If
End Sub
如前所述，如果用户单击 Cancel ，则会出现运行时语法错误，用户必须选择 Debug 并单击 F5 继续。这是On Error Resume Next适合的情况类型。我已将此添加到您的原始代码中并包含退出选项。除了显示其地址外，此宏不使用输入的范围。
使用 Ctrl + 左鼠标可以选择非连续范围。你没有说你是否希望能够选择第4,5,11和4列，但是，由于你无法阻止用户选择不连续的范围，我已经包含了处理它们的代码。
我多次运行这个宏。我第一次选择B和C列时，下次取消时我选择了各种混合范围。输出是：
$B:$C
User wants immediate exit
$B$1,$D$1
$B$1,$C$1,$E$1
$B$1:$D$1
$B:$B,$E:$E
$B:$C,$E:$E,$F:$F,$H:$H
$B:$B,$E$2
请注意，如果我选择列，则会收到$B:$B或$B:$C，如果选择一个单元格，则会$E$1。在最后一行中，我选择了一列和一个单元格。
玩这个宏并了解它可以从用户获得的范围。
不知何故，您需要将从用户获得的范围转换为一列或多列。
将此代码添加到上面宏的底部：
Dim Count As Long
Dim RngCrnt As Range
Count = 0
For Each RngCrnt In CalcRange
Debug.Print " " & RngCrnt.Address
Count = Count + 1
If Count = 10 Then
Exit For
End If
Next
Debug.Print CalcRange.EntireColumn.Address
For Each RngCrnt In CalcRange.EntireColumn
Debug.Print " " & RngCrnt.Address
Count = Count + 1
If Count = 10 Then
Exit For
End If
Next
在此代码中，我使用For Each语句将用户范围拆分为子范围。我运行了宏，选择了列B和C，得到了以下输出：
$B:$C
$B$1
$C$1
$B$2
$C$2
$B$3
$C$3
$B$4
$C$4
$B$5
$C$5
$B:$C
$B:$B
$C:$C
对于第一个For Next，子范围是一个单元格。如果我省略了将输出限制为10的代码，那么每列中每个单元格会有一个显示行。
在第二个For Next中，我通过添加.EntireColumn调整了用户的范围。这对Debug.Print CalcRange.EntireColumn.Address显示的地址没有影响，但已将子范围更改为我想要的列。
我认为这是了解修改后的宏所需的所有新信息。我希望能给你一个变化列表，但是有太多的变化可以使它变得切合实际。
Sub ExtractMaxTemperatures2()
' Adjusted to handle user selected columns
Const RowSht1DataFirst As Long = 2 ' First non-header row in Sheet1
Const ColSht2Dest As Long = 2 ' Left column \ of table of extracted
Const RowSht2Dest As Long = 3 ' Top row / values in Sheet2
Dim ColLogicalCrnt As Long ' 1, 2, 3 and so on regardless of true column number
Dim ColSht1Crnt As Long ' Current column within Sheet1
Dim ColSht2Crnt As Long ' Current column within Sheet2
Dim NumColsSelected As Long ' Number of columns selected.
Dim Reply As Long ' Return value from InputBox
Dim RowForMaxCrnt As Long ' Row holding maximum temperature found so far within current column
Dim RowSht1Crnt As Long ' Current row within Sheet1
Dim RowSht2Crnt As Long ' Current row within Sheet2
Dim RngColCrnt As Range ' Sub-range of user selected range giving current column
Dim RngUserSelected ' Range selected by user then adjusted with .EntireColumn
Dim ShtValue As Variant ' 2D array holding values loaded from Sheet1
Dim TempCrnt As Single ' The temperature from the current cell
Dim TempMaxCrnt As Single ' Maximum temperature found so far within current column
' Declare arrays to hold the maximum temperature and its row for each column.
' These arrays will be sized at runtime.
Dim TempMaxByCol() As Single ' Maximum temperature for each logical column
Dim RowForMaxTemp() As Long ' Row for maximum temperature for each logical column
With Worksheets("Sheet1")
ShtValue = .UsedRange.Value
.Activate ' Necessary to ensure Sheet1 visible for range selection
End With
Do While True
Err.Clear
On Error Resume Next
Set RngUserSelected = Application.InputBox(Prompt:="Select columns to be copied", _
Title:="Extract maximum temperatures", Type:=8)
On Error GoTo 0
If Err.Number <> 0 Then
Reply = MsgBox(Prompt:="Do you wish to exit without extracting any temperatures?", _
Buttons:=vbYesNo, Title:="Extract maximum temperatures")
If Reply = vbYes Then
' User wants to exit
Exit Do
End If
' Loop for another go
Else
' User had entered a valid range
Exit Do
End If
Loop
If RngUserSelected Is Nothing Then
Debug.Print "User wants immediate exit"
End If
' Convert any cells to columns
Set RngUserSelected = RngUserSelected.EntireColumn
' Count number of selected columns
NumColsSelected = 0
For Each RngColCrnt In RngUserSelected
NumColsSelected = NumColsSelected + 1
Next
' Size arrays for number of selected columns
ReDim TempMaxByCol(1 To NumColsSelected) As Single
ReDim RowForMaxTemp(1 To NumColsSelected) As Long
' Fill TempMaxByCol and RowForMaxTemp with extracted values
ColLogicalCrnt = 0
' Loop for each temperature column
For Each RngColCrnt In RngUserSelected
ColSht1Crnt = RngColCrnt.Column
ColLogicalCrnt = ColLogicalCrnt + 1 ' Logical column for this physical column
RowForMaxCrnt = 0 ' Indicates no temperature saved yet
' Loop for each data row column. UBound(ShtValue, 2) identifies the last row.
For RowSht1Crnt = RowSht1DataFirst To UBound(ShtValue, 1)
If IsNumeric(ShtValue(RowSht1Crnt, ColSht1Crnt)) Then
' This cell is numeric
TempCrnt = Val(ShtValue(RowSht1Crnt, ColSht1Crnt))
If RowForMaxCrnt <> 0 Then
' A possible maximum temperature has already been stored.
' Check current value against it.
If TempMaxCrnt < TempCrnt Then
' Higher temperature found. Store details in temporary variables
RowForMaxCrnt = RowSht1Crnt
TempMaxCrnt = TempCrnt
End If
Else
' First temperature found. Store details in temporary variables
RowForMaxCrnt = RowSht1Crnt
TempMaxCrnt = TempCrnt
End If
End If
Next
'Move values from temporary variables to arrays
TempMaxByCol(ColLogicalCrnt) = TempMaxCrnt
RowForMaxTemp(ColLogicalCrnt) = RowForMaxCrnt
Next
' Initialise the current row to the start row of the outout table
RowSht2Crnt = RowSht2Dest
' I think you call the destination sheet "Calc" but I have used "Sheet2"
With Worksheets("Sheet2")
' Create header lines
' TC1 TC2 TC3 TC4
' Max Row Max Row Max Row Max Row
' This code will handle multiple header rows
For RowSht1Crnt = 1 To RowSht1DataFirst - 1
ColSht2Crnt = ColSht2Dest
ColLogicalCrnt = 0
For Each RngColCrnt In RngUserSelected
ColSht1Crnt = RngColCrnt.Column
ColLogicalCrnt = ColLogicalCrnt + 1 ' Logical column for this physical column
' Merge two cells together ready for column name
.Range(.Cells(RowSht2Crnt, ColSht2Crnt), _
.Cells(RowSht2Crnt, ColSht2Crnt + 1)).Merge
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = ShtValue(RowSht1Crnt, ColSht1Crnt)
.HorizontalAlignment = xlCenter
End With
ColSht2Crnt = ColSht2Crnt + 2
Next
RowSht2Crnt = RowSht2Crnt + 1
Next
' Now add "Max Row Max Row Max Row Max Row" row
ColSht2Crnt = ColSht2Dest
' ColLogicalCrnt = 0 ' Don't need logical column for this loop
For Each RngColCrnt In RngUserSelected
ColSht1Crnt = RngColCrnt.Column
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = "Max"
.HorizontalAlignment = xlRight
End With
ColSht2Crnt = ColSht2Crnt + 1
With .Cells(RowSht2Crnt, ColSht2Crnt)
.Value = "Row"
.HorizontalAlignment = xlRight
End With
ColSht2Crnt = ColSht2Crnt + 1
Next
RowSht2Crnt = RowSht2Crnt + 1
' Now create data row
ColSht2Crnt = ColSht2Dest
ColLogicalCrnt = 0
' Loop for each temperature column
For Each RngColCrnt In RngUserSelected
' ColSht1Crnt = RngColCrnt.Column ' Don't need Sheet 1 column for this loop
ColLogicalCrnt = ColLogicalCrnt + 1 ' Logical column for this physical column
.Cells(RowSht2Crnt, ColSht2Crnt).Value = TempMaxByCol(ColLogicalCrnt)
ColSht2Crnt = ColSht2Crnt + 1
.Cells(RowSht2Crnt, ColSht2Crnt).Value = RowForMaxTemp(ColLogicalCrnt)
ColSht2Crnt = ColSht2Crnt + 1
Next
End With
End Sub