微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

VBA Excel,如何提取特定列中的最大值并在特定工作表中显示最大值

如何解决VBA Excel,如何提取特定列中的最大值并在特定工作表中显示最大值

我想要实现的是工作簿中所有工作表中的最大值并将它们收集在特定工作表中 我的 vba 代码适用于一个特定的单元格,当我尝试添加 for 循环时什么也没发生,我的 excel 不会响应和冻结 如果有人能提供帮助,我将不胜感激。

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

解决方法

请尝试下一个版本。它检查 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),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

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

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。