Question

我可以改进以下代码，还是有其他方法可以在更短的时间内完成目标？

我的目标是连接各个国家和独特品牌的类别。

在当前结构中，一行代表一个品牌，一个类别和一个国家/地区。在我的输出中，我想要每个品牌的行，有一个与所有国家/地区连接的单元格和一个连接所有类别的单元格。

到目前为止我的解决方案：

我的Excel工作簿有三张"HelpSheet"，"Input"和"Output"。

"HelpSheet"包含没有重复的品牌名称列表。 "Input"具有原始数据（一行，一个条目）。 "Output"每个品牌名称应填充一行。

"Input"约25.000行。 "HelpSheet"约5.000行。

编辑：现在我使用变体存储我的范围以避免VBA /工作表开销。现在我得到了“内存不足” - 错误。

在VBA中我写了这个：

Sub CellsTogether()

Dim ipRange As Variant
Dim hsRange As Variant
Dim countryCount As Long
Dim categoryCount As Long
Dim brandArray() As String
Dim categoryStr As String
Dim countryStr As String
Dim countryArr() As String
Dim categoryArr() As String
Dim identifier As String
Dim i As Long
Dim j As Long
Dim iRow As Long
Dim iCol As Long
Dim k As Long
Dim l As Long
Dim lastRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

ipRange = Worksheets("Input").Range("B3:N29316")
hsRange = Worksheets("HelpSheet").Range("A1:A4781")
countryCount = 1
categoryCount = 1

For j = LBound(hsRange, 1) To UBound(hsRange, 1)
    For iRow = LBound(ipRange, 1) To UBound(ipRange, 1)
        iCol = 1
        If ipRange(iRow, iCol) = hsRange(j, 1) Then

            ReDim Preserve countryArr(1 To countryCount)
            ReDim Preserve categoryArr(1 To categoryCount)

            For k = LBound(countryArr) To UBound(countryArr)
                If countryArr(k) = ipRange(iRow, iCol + 2) Then
                    Exit For
                Else
                    countryArr(UBound(countryArr)) = ipRange(iRow, iCol + 2)
                    countryCount = countryCount + 1
                End If
            Next k

            For l = LBound(categoryArr) To UBound(categoryArr)
                If categoryArr(l) = ipRange(iRow, iCol + 12) Then
                    Exit For
                Else
                    categoryArr(UBound(categoryArr)) = ipRange(iRow, iCol + 12)
                    categoryCount = categoryCount + 1
                End If
            Next l

            identifier = ipRange(iRow, iCol + 3)

        End If
    Next iRow

    For k = LBound(countryArr) To UBound(countryArr)
        countryStr = countryStr & countryArr(k) & Chr(10)
    Next k
    For k = LBound(categoryArr) To UBound(categoryArr)
        categoryStr = categoryStr & categoryArr(k) & Chr(10)
    Next k

    Worksheets("Output").Cells(j + 2, 3).Value = hsRange(j, 1)
    Worksheets("Output").Cells(j + 2, 6).Value = countryStr
    Worksheets("Output").Cells(j + 2, 5).Value = categoryStr
    Worksheets("Output").Cells(j + 2, 2).Value = identifier

Next j

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

然而，这需要很长时间才能计算出来。

有任何改进吗？

循环超过5000行？需要改进

0 个答案: