Question

这可能是一个简单的问题，但在几个小时后试图放弃......

我希望宏能够找到从最小值到最大值的范围。应将此范围复制并粘贴到某种＆＃34;摘要表＆＃34;。

我能够让宏找到最小值和最大值，我还得到了一个有效的复制粘贴指令。

有人可以帮我把这些说明合并成一个吗？

就我而言，这是我的宏：

Sub Enter_Formula()

    Dim blatt
    Dim sheetName As String
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range("=Min(A59:A86):=Max(A:A)").Copy Range("C1")
    Next

End Sub

谢谢！

Answer 1

我会如下：

Sub Enter_Formula()
    Dim sht As Worksheet, summarySht As Worksheet

    Set summarySht = Worksheets("Summary") '<--| change "Summary" to your actual "Summary" sheet name

    For Each sht In Worksheets
       If sht.Name <> summarySht.Name Then
            With sht.Range("A59:A86")
                .Parent.Range(.Find(what:=WorksheetFunction.Min(.Cells), lookat:=xlWhole, LookIn:=xlValues), .EntireColumn.Find(what:=WorksheetFunction.Max(.EntireColumn), lookat:=xlWhole, LookIn:=xlValues)).Copy summarySht.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
            End With
       End If
    Next
End Sub

Answer 2

直接评估表达式（测试）可能会快一点：

Dim ws As Worksheet

For Each ws In Worksheets
    ws.Range("Index(A59:A86,Match(Min(A59:A86),A59:A86,0)):Index(A:A,Match(Max(A:A),A:A,0))").Copy ws.Range("C1")
Next

复制粘贴范围从最小到最大

2 个答案: