3

私は、ExcelでSumIf関数を実行するための最速の方法を考え出そうとしています。110'000行。私は3つの方法を考え出しましたが、どれも満足のいくものではありません。

これが私が最初に試したものです:私のPCでの実行時間は100秒です!

    Sub Test1_WorksheetFunction()

Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime

StartTimer = Now()

With wsTest
    MaxRow = .UsedRange.Rows.Count
    MaxCol = .UsedRange.Columns.Count

    For i = 2 To MaxRow
        .Cells(i, 4) = WorksheetFunction.SumIf(wsData.Range("G2:G108840"), .Cells(i, 1), wsData.Range("R2:R108840"))
    Next i

End With

EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

これが2番目の方法です:実行時間は55秒で少し良くなります

Sub Test2_Formula_and_Copy()

Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime

StartTimer = Now()

With wsTest
    MaxRow = .UsedRange.Rows.Count
    MaxCol = .UsedRange.Columns.Count

    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIF(Tabelle1[KUNDENBESTELLNR],Test!RC[-3],Tabelle1[ANZAHL NACHFRAGE])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D6285")
    Range("D2:D6285").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End With

EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

3回目の試行:実行が非常に遅いため、終了しませんでした。

Sub Test3_Read_in_Array()

Dim MaxRow As Long, MaxCol As Long
Dim SearchRange() As String, SumRange() As Long
Dim i As Long, j As Long, k
Dim StartTimer, EndTimer, UsedTime
Dim TempValue

StartTimer = Now()

With wsData
    MaxRow = .UsedRange.Rows.Count
    ReDim SearchRange(1 To MaxRow)
    ReDim SumRange(1 To MaxRow)
    For i = 1 To MaxRow
        SearchRange(i) = .Range("G" & (1 + i)).Value
        SumRange(i) = .Range("R" & (1 + i)).Value
    Next i
End With

With wsTest
    MaxRow = .UsedRange.Rows.Count
    For i = 2 To MaxRow
        For j = LBound(SearchRange) To UBound(SearchRange)
            k = .Cells(i, 1).Value
            If k = SearchRange(j) Then
            TempValue = TempValue + SumRange(j)
            End If
        Next j
        .Cells(i, 4) = TempValue
    Next i
End With


EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

明らかに、私はまだVBA(またはその他のプログラミング言語)を習得していません。誰かがこれを効率的にするのを手伝ってくれますか?方法があるに違いない!右?

ありがとう!

4

3 に答える 3

3

これを回してください

Sub test()
    StartTimer = Now()
    With ActiveSheet.Range("D2:D6285")
        .FormulaR1C1 = "=SUMIF(Tabelle1[KUNDENBESTELLNR],Test!RC[-3],Tabelle1[ANZAHL NACHFRAGE])"
        .Value = .Value
    End With
    EndTimer = Now()
    MsgBox (DateDiff("s", StartTimer, EndTimer))
End Sub
于 2012-10-19T14:06:03.403 に答える
0

私のバージョンは、kevin999 のソリューションに触発されました。

++ ソートされていない sumif 基準で動作します
++ は行を元の順序に戻します

-- 複数の条件列はサポートされていません

注意: 基準と合計するデータを含む列は、隣り合っている必要があります。

Option Explicit

Sub Execute()
Call FasterThanSumifs(1)
End Sub

Private Sub FasterThanSumifs(Criteria As Long)
'Expects two coloumns next to each other:
'SumIf criteria (left side)
'SumIf data range (right side)

Dim SumRange, DataNumber, HelpColumn, SumifColumn, LastRow As Long
SumRange = Criteria + 1
DataNumber = Criteria + 2
HelpColumn = Criteria + 3
SumifColumn = Criteria + 4
LastRow = UF_LetzteZeile()

Columns(DataNumber).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(HelpColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(SumifColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'Remember data order
Cells(2, DataNumber).Value = 1
Cells(2, DataNumber).AutoFill Destination:=Range(Cells(2, DataNumber), Cells(LastRow, DataNumber)), Type:=xlFillSeries

'Sort the range of returned values to place the largest values above the lower ones
Range(Cells(1, Criteria), Cells(LastRow, SumifColumn)).Sort Key1:=Columns(Criteria), Order1:=xlAscending, Header:=xlYes
ActiveSheet.Sort.SortFields.Clear

'If formula sums the range-to-sum where the values are the same
With Range(Cells(2, HelpColumn), Cells(LastRow, HelpColumn))
    .FormulaR1C1 = "=IF(RC[-3]=R[-1]C[-3], RC[-2] + R[-1]C,RC[-2])"
    '.Value = .Value
End With

'If formula returns the maximum value for each concatenated value match &
'is therefore the equivalent of using a Sumifs formula
With Range(Cells(2, SumifColumn), Cells(LastRow, SumifColumn))
    .FormulaR1C1 = "=IF(RC[-4]=R[+1]C[-4], R[+1]C, RC[-1])"
    .Value = .Value
End With

Columns(HelpColumn).Delete

'Sort the range in the original order
Range(Cells(1, Criteria), Cells(LastRow, SumifColumn)).Sort Key1:=Columns(DataNumber), Order1:=xlAscending, Header:=xlYes
ActiveSheet.Sort.SortFields.Clear

Columns(DataNumber).Delete

End Sub
于 2014-09-03T16:41:03.053 に答える