0

ここに画像の説明を入力

こんにちは、ARTICLE が同じで空白でない場合、列 VALUES1、VALUES2、VALUES3 の値をコピーするマクロを実行しています。

最初のスプレッドシートがあり、マクロが 2 番目のスプレッドシートを返すようにします。

私はそれを作る方法を管理しました:

Sub test()

Dim i, last, j, x As Integer
Dim R As Range

last = Sheets("List2").Range("A100000").End(xlUp).Row - 2

For i = 0 To last

    Set R = Sheets("List2").Range("A2")

        If Not WorksheetFunction.CountIf(Sheets("List2").Columns(1), _
        Sheets("List2").Range("A2").Offset(i, 0).Value) = 0 Then

            For j = 1 To WorksheetFunction.CountIf(Sheets("List2").Columns(1), _

                Sheets("List2").Range("A2").Offset(i, 0).Value)
                Set R = Sheets("List2").Columns(1).Find(Sheets("List2").Range("A2"). _
                Offset(i, 0).Value, R, LookAt:=xlWhole)

                    For x = 0 To 2

                        If Not Sheets("List2").Range("B2").Offset(i, x).Value = "" Then

                            R.Offset(0, "1" + x).Value = Sheets("List2"). _ 
                            Range("B2").Offset(i, x).Value

                        End If
                    Next x
            Next j
        End If
Next i

End Sub

しかし、時間がかかりすぎるという問題があります。約 10,000 行と 20 列があり、さらにスプレッドシートが整っていないため、(A、B、B、A、.. .)

より速くまたはより良くする方法はありますか???

どうもありがとう。テーマストーン。

4

1 に答える 1

2

これは、問題に対する数式を使用した非常に簡単な解決策です。

Sheet2!A1=Sheet1!A1
Sheet2!B1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!B:B)

Sheet2!C1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!C:C)
Sheet2!D1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!D:D)

これらの数式を の左側のセルに入れ、=下にコピーします。2 番目も右側にコピーできるので、本当に必要なのは最初の 2 つだけです。

記事ごとにシート 1 を並べ替える必要があります。

それでおしまい。

もちろん、これを VBA で実装する必要がある場合もあります。通常、VBA で大量のセルを処理する最も速い方法は、範囲の配列コピーを使用することです。ワークシート関数を使用し、単一のセル参照をループすると、速度が大幅に低下します。

編集：

これは私のVBAソリューションになります

Public Sub Demo()
  Dim arrRange() As Variant
  Dim arrRangeResult() As Variant
  Dim i As Long
  Dim j As Long
  Dim copyVal As Variant
  Dim copyCond As Variant
  Dim copyCol As Long

  'create two copies of the origin data
  arrRange = Range("A:D")
  arrRangeResult = Range("A:D")

  'loop through first data-copy, downwards through the articles
  For i = LBound(arrRange, 1) + 1 To UBound(arrRange, 1)
    'stop loop, if no article was found
    If arrRange(i, 1) = "" Then Exit For
    'store current article ID
    copyCond = arrRange(i, 1)
    'loop sideways through value-columns
    For j = LBound(arrRange, 2) + 1 To UBound(arrRange, 2)
      'store value & column, when found
      If arrRange(i, j) <> "" Then
        copyVal = arrRange(i, j)
        copyCol = j
        Exit For
      End If
    Next j

    'loop through output array and paste value
    For j = LBound(arrRangeResult, 1) + 1 To UBound(arrRangeResult, 1)
      If arrRangeResult(j, 1) = copyCond Then
        'paste-down found value to all occurences of article
        arrRangeResult(j, copyCol) = copyVal
      ElseIf arrRangeResult(j, 1) = "" Then
        'early stop, when no article ID is found
        Exit For
      End If
    Next j
  Next i

  'create output
  Range("K:N") = arrRangeResult
End Sub
于 2012-11-20T12:14:49.867 に答える