-1

我想要实现的是我的工作簿中所有工作表中的最大值，并将它们收集到一个特定的工作表中回应并冻结如果有人可以提供帮助，我将不胜感激。

Dim wsDst As Worksheet
Dim ws As Worksheet
Dim x As Long
Dim lngMax As Long
Set wsDst = Sheets("Summary")
 Application.ScreenUpdating = False
  For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> wsDst.Name And ws.Name <> "Amirhossein" Then
       For ZZ = 4 To 9999
        For Q = 25 To 9999
         With ws
            x = Application.WorksheetFunction.max(.Cells(ZZ, 26))
            If x > lngMax Then
                wsDst.Cells(Q, 10).Value = x
                lngMax = wsDst.Cells(Q, 10).Value
            End If
        End With
    Next Q
    Next ZZ

    End If
Next ws
4

1 回答 1

0

请尝试下一个版本。它检查 X:Z 列中的每个单元格值并提取 Max，它位于“摘要”表的同一单元格中：

Sub testMaxXZMultipleSheets()
  Dim sh As Worksheet, wsDst As Worksheet, arr, arrRng
  Dim k As Long, i As Long, j As Long
  
  Set wsDst = Sheets("Summary")
  ReDim arr(ThisWorkbook.Worksheets.Count - 1) 'redim the array to the maximum number of sheets
  For Each sh In ThisWorkbook.Sheets           'put all sheet objects in the arr array
    If sh.Name <> wsDst.Name And sh.Name <> "Amirhossein" Then
        Set arr(k) = sh: k = k + 1
    End If
  Next
  ReDim Preserve arr(k - 1) 'keep only the array elements keeping a sheet object
  For j = 24 To 26          'iterate only between columns X:Z (24:26):
    For m = 4 To arr(1).Range("X" & Rows.Count).End(xlUp).Row 'it assumes that all shets have the same number of rows
        ReDim arrRng(UBound(arr))
        For i = 0 To UBound(arr)        'create an array of each value of the same cell for all sheets in arr array
          arrRng(i) = IIf(IsError(arr(i).Cells(m, j).Value), 0, arr(i).Cells(m, j).Value)
        Next i
        wsDst.Cells(m, j).Value = WorksheetFunction.max(arrRng) 'put the Max value in the same 'Summary' position
    Next m
 Next j
 MsgBox "Ready..."
End Sub

请在测试后发送一些反馈。

于 2021-01-01T18:58:34.403 回答