Question

（1）如果有人可以简单地帮助我，我会感激不尽。我无法弄清楚如何将公式“整行”包含在下面的代码中，以便宏在F列中从min到max复制，但也复制到每个数据点的整行......

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

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

For Each sht In Worksheets
   If sht.Name <> summarySht.Name Then
        With sht.Range("F15000:F20000")
            .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

（2）另一个问题是，如何修改代码，以便excel为宏运行的每个工作表创建一个额外的“摘要”表。我不希望所有找到的范围都有一个汇总表，因为这对读者来说太混乱了。

非常感谢！

Answer 1

试试这个（不确定你真的需要复制整行吗？）摘要表名称只是以“摘要”开头的表格名称。

Sub x()

Dim sht As Worksheet, summarySht As Worksheet
Dim rMin As Range, rMax As Range

For Each sht In Worksheets
   If Not sht.Name Like "Summary*" Then
        Set summarySht = Sheets.Add(after:=Sheets(Sheets.Count))
        summarySht.Name = "Summary " & sht.Name
        With sht.Range("F15000:F20000")
            Set rMin = .Find(what:=WorksheetFunction.Min(.Cells), lookat:=xlWhole, LookIn:=xlValues)
            Set rMax = .EntireColumn.Find(what:=WorksheetFunction.Max(.EntireColumn))
            .Parent.Range(rMin, rMax).EntireRow.Copy summarySht.Range("A1")
        End With
   End If
Next sht

End Sub

复制粘贴范围（包括整数）从最小值到最大值

1 个答案: