VBA循环各种任意选择的列,找到最大值,将其保存在每列下方的单元格中

时间:2015-09-27 17:04:07

标签: excel-vba vba excel

数据组有多列,所有组都位于sheet1上的任意位置。像

这样的东西
n <- 100
mapply(function(x,y) tidy(t.test(x,y)), 
       replicate(n, sample(x, size=20, replace=FALSE), simplify=FALSE), 
       replicate(n, sample(y, size=20, replace=FALSE), simplify=FALSE))

由于不重要的原因,该块可以任意地位于工作表上,并且各种列长度可以改变。我突出显示数据以选择它并开始该过程。

我想循环遍历所有数据并找到每个值列的最大值,并将其写入同一列中较低的单元格中。

列和行的任意性质导致我心脏燃烧。如何在脚本中引用它们。

1 个答案:

答案 0 :(得分:0)

这预计每组之间存在2行差距

Sub findValuesForGroups()
    Dim found As Range, adr As String, clr As Long, rng As Range, frm As String, lr As Long

    clr = RGB(222, 222, 222)
    Application.ScreenUpdating = False

    With ActiveWorkbook.ActiveSheet.UsedRange

      Set found = .Find(What:="Values for *", After:=.Cells(.Rows.Count, .Columns.Count), _
                        SearchOrder:=xlByColumns)
        If Not found Is Nothing Then
            adr = found.Address
            Do
                formatCell found.Resize(1, 2), clr
                lr = found.End(xlDown).Row - found.Row
                frm = "=Max(" & found.Offset(1).Resize(lr, 1).Address & ")"

                If found.Offset(lr - 1).Value2 = "Max" Then
                    found.Offset(lr - 1).Resize(2, 1).Clear
                    lr = lr - 2
                    frm = "=Max(" & found.Offset(1, 0).Resize(lr, 1).Address & ")"
                End If

                found.Offset(lr + 1).Value2 = "Max"
                found.Offset(lr + 2).Formula = frm
                formatCell found.Offset(lr + 1).Resize(2, 1), vbYellow

                Set found = .FindNext(found)
            Loop While Not found Is Nothing And found.Address <> adr
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Private Sub formatCell(ByRef cel As Range, ByVal clr As Long)
    With cel
        .Interior.Color = clr
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Borders.Weight = xlThin
    End With
End Sub

enter image description here