1

dataimportマクロを実行していて、列xの値が等しいデータセット内のすべての行をマージしたいのですが、次に、列であるグループx[y]xの平均を表す行を取得したいと思います。 yは、その特定のグループの列xの値です。

これを行うための単純な関数はありますか、それとも多くの予備サイクルを含む大規模なループを作成する必要がありますか？

明示： つまり、私のデータセットは次のようになります

 A    |    B     |    C
 1         2          4
 1         2          5
 2         7          3
 2         5          1
 3         2          1
 1         5          6

ここで、行を列Aの値でマージしたいので、値が等しいすべてのAは残りの行を平均化して、次のようなものを取得します。

 A    |    B     |    C
 1         3          5
 2         6          2
 3         2          1

これまで、この関数を使用して列A（1〜10）の可能な値を手動でループしようとしてきましたが、Excelがクラッシュし続け、理由がわかりません。このどこかに無限ループが必要です。働き：

Function MergeRows(sheet, column, value)
Dim LastRow
Dim LastCol
Dim numRowsMerged
Dim totalValue

numRowsMerged = 1
LastRow = sheet.UsedRange.Rows.Count
LastCol = sheet.UsedRange.Columns.Count
With Application.WorksheetFunction
    For iRow = LastRow - 1 To 1 Step -1
        'enter loop if the cell value matches what we're trying to merge
        Do While Cells(iRow, column) = value
               For iCol = 1 To LastCol
                'skip the column that we're going to use as merging value, and skip the column if it contains 3 (ikke relevant)
                If Not (iCol = column) And Not (Cells(iRow, iCol) = 3) Then
                    Cells(iRow, iCol) = (Cells(iRow, iCol) * numRowsMerged + Cells(iRow + 1, iCol)) / (numRowsMerged + 1)
                End If
               Next iCol
            'delete the row merged
            Rows(iRow + 1).Delete
        Loop

        'add one to the total number of rows merged
        numRowsMerged = numRowsMerged + 1
    Next iRow
End With

End Function

ソリューション 私は、次のように、Unionを使用して徐々に拡張する範囲を作成することになりました。

  Function GetRowRange(sheet, column, value) As range
Dim LastRow
Dim LastCol
Dim numRowsMerged
Dim totalValue
Dim rowRng As range
Dim tempRng As range
Dim sheetRange As range

numRowsMerged = 1
Set sheetRange = sheet.UsedRange
LastRow = sheet.UsedRange.Rows.Count
LastCol = sheet.UsedRange.Columns.Count
With Application.WorksheetFunction
    For iRow = 1 To LastRow Step 1
        'enter loop if the cell value matches what we're trying to merge
        If (sheetRange.Cells(iRow, column) = value) Then
            Set tempRng = range(sheetRange.Cells(iRow, 1), sheetRange.Cells(iRow, LastCol))
            If (rowRng Is Nothing) Then
                Set rowRng = tempRng
            Else
                Set rowRng = Union(rowRng, tempRng)
            End If
        End If

        'add one to the total number of rows merged
        numRowsMerged = numRowsMerged + 1
    Next iRow
End With
Set GetRowRange = rowRng
End Function
4

2 に答える 2

2

これはあなたがしようとしていることですか？VBAコードが必要だったので、ピボットは使用しませんでしたが、より単純なオプションを使用しました。formulasあなたの平均を計算します。

Option Explicit

Sub Sample()
    Dim col As New Collection
    Dim wsI As Worksheet, wsO As Worksheet
    Dim wsIlRow As Long, wsOlRow As Long, r As Long, i As Long
    Dim itm

    '~~> Chnage this to the relevant sheets
    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    '~~> Work with the input sheet
    With wsI
        wsIlRow = .Range("A" & .Rows.Count).End(xlUp).Row
        '~~> get unique values from Col A
        For i = 1 To wsIlRow
            On Error Resume Next
            col.Add .Range("A" & i).Value, """" & .Range("A" & i).Value & """"
            On Error GoTo 0
        Next i
    End With

    r = 1

    '~~> Write unique values to Col A
    With wsO
        For Each itm In col
            .Cells(r, 1).Value = itm
            r = r + 1
        Next

        wsOlRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Use a simple formula to find the average
        For i = 1 To wsOlRow
            .Range("B" & i).Value = Application.Evaluate("=AVERAGE(IF(" & wsI.Name & _
                                    "!A1:A" & wsIlRow & "=" & .Range("A" & i).Value & _
                                    "," & wsI.Name & "!B1:B" & wsIlRow & "))")

            .Range("C" & i).Value = Application.Evaluate("=AVERAGE(IF(" & wsI.Name & _
                                    "!A1:A" & wsIlRow & "=" & .Range("A" & i).Value & _
                                    "," & wsI.Name & "!C1:C" & wsIlRow & "))")
        Next i
    End With
End Sub

スクリーンショット

ここに画像の説明を入力してください

于 2013-02-18T09:25:36.083 に答える
0

これは、ピボットテーブルを使用して簡単に行うことができます。

これが最終結果の写真です。 Excelピボットテーブル

于 2013-02-14T16:57:45.943 に答える