如何动态计算过滤数据的多个表的平均值- VBA

Question

我有一个表，我需要找到不同样本中存在的元素。对于每个样本，迭代次数是一个变量—我可以有两行样本1和3行样本2或5行样本4。作为元素的列的数量也可以不同。在这种情况下，我考虑了3个样本和17个元素。我需要根据样本进行过滤。比如样本1。然后需要计算样本1的所有项的平均值。然后，在样本2的下面，需要显示样本2的值，并计算样本2所有条目的平均值。

我是vba的初学者，因此我使用的代码不能为值的动态范围做。此外，我只能使用宏记录器计算平均值。我不知道如何将这两个代码合二为一。我试着在这个话题上搜索了很多

我也包括了我的代码。任何帮助都将非常感激!!谢谢你

Sub sorttable()
Dim j As Long 'row variable
On Error GoTo Err_Execute
Dim i As Long
'Start search in row 1 in sheet1
j = 1
'Column counter for sheet2
i = 1
While Len(Range("A" & CStr(j)).Value) > 0

If Range("A" & CStr(j)).Value = "Sample1" Then
Range(Range("A" & CStr(j)), Range("A" & CStr(j)).End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
Sheet2.Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Cells(j + 1, 1) = "=AVERAGE(A1:C" & j - 1 & ")" 'used to calculate avg
i = i + 1
Sheets("Sheet1").Select
ElseIf Range("A" & CStr(j)).Value = "Sample2" Then
Range(Range("A" & CStr(j)), Range("A" & CStr(j)).End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
Sheet2.Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Sheets("Sheet1").Select
ElseIf Range("A" & CStr(j)).Value = "Sample3" Then
Range(Range("A" & CStr(j)), Range("A" & CStr(j)).End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
Sheet2.Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Sheets("Sheet1").Select
End If
j = j + 1
Wend
Application.CutCopyMode = False
MsgBox "the values have been extracted"
Exit Sub
Err_Execute:
MsgBox "Error Occured"
End Sub
'code- part of it for calculating the average
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A9:B9"), Type:=xlFillDefault
Range("A9:B9").Select
Range("B9").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "= AVERAGE(R[-2]C,R[-1]C)"
Range("B9").Select
Selection.AutoFill Destination:=Range("B9:R9"), Type:=xlFillDefault
Range("B9:R9").Select
Range("A11").Select
Sheets("Sheet2").Select
Range("A27").Select
Sheets("Sheet1").Select
Range("A8:R10").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A11").Select
ActiveSheet.Paste
Range("A14").Select
Application.CutCopyMode = False
Selection.Style = "Normal 2"
ActiveCell.FormulaR1C1 = "Average"
Range("B14").Select
ActiveCell.FormulaR1C1 = "= AVERAGE(R[-3]C:R[-1]C)"
Range("B14").Select
Selection.AutoFill Destination:=Range("B14:R14"), Type:=xlFillDefault
Range("B14:R14").Select
Range("A16").Select
End Sub

Answer 1

看起来您已经将宏记录为开始，然后尝试从那里修改它。这是很好的第一步，所以现在有一些事情需要注意:

1. 宏记录器捕获了许多不必要的东西，所以不要使用Select或Activate。
2. 由于每个样本组的数据可能不相同，因此代码必须考虑到这一点。查看下面的示例代码，注意它会循环计算示例组中有多少行，然后动态地填充该组的列的公式。

Option Explicit
Sub SortTable()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim numSampleRows As Long
    numSampleRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
    Dim sampleRow As Range
    Set sampleRow = ws.Range("A2")
    Dim i As Long
    Dim numSamplesInGroup As Long
    Dim currentSampleLabel As String
    Dim numSampleColumns As Long
    Dim avgRow As Long
    Dim avgCol As Long
    For i = 1 To (numSampleRows + 1)
        '--- look at the sample labels to determine how
        '    many are in this group
        If numSamplesInGroup = 0 Then
            '--- this is the start of a sample group
            currentSampleLabel = sampleRow.Offset(0, 0)
            numSamplesInGroup = 1
        ElseIf currentSampleLabel = sampleRow.Offset(0, 0) Then
            '--- continue to count the samples in the group
            numSamplesInGroup = numSamplesInGroup + 1
        Else
            '--- we've reached the end of the sample group
            '    so insert two empty rows here
            sampleRow.EntireRow.Insert
            sampleRow.EntireRow.Insert
            Debug.Print sampleRow.Address
            '--- create the AVERAGE formula for each populated column
            '    ASSUMES all the columns are consistent for each sample group
            avgRow = sampleRow.Offset(-2, 0).Row
            ws.Cells(avgRow, 1) = "Average"
            numSampleColumns = ws.Cells(avgRow - 1, ws.Columns.Count).End(xlToLeft).Column
            For avgCol = 1 To (numSampleColumns - 1)
                sampleRow.Offset(-2, avgCol).FormulaR1C1 = _
                        "=AVERAGE(R" & _
                           avgRow - numSamplesInGroup & _
                        "C" & avgCol + 1 & _
                        ":R" & avgRow - 1 & "C" & avgCol + 1 & ")"
            Next avgCol
            '--- reset for the next loop
            currentSampleLabel = sampleRow.Offset(0, 0)
            numSamplesInGroup = 0
        End If
        '--- move down one row
        Set sampleRow = sampleRow.Offset(1, 0)
    Next i
End Sub