Question

我有一个超过100,000行和几列的数据集。

我想要实现的是查找另一个范围内的值，如果匹配，请将其放在旁边的列中。如果有多个值匹配，请插入另一行并将其放入。

然而，代码需要永远加载，我的Excel最终会崩溃......帮助！

Sub Splitter_Step1a()

Dim RefSheet As Worksheet
Set RefSheet = ActiveWorkbook.Worksheets("RefList")
Dim ProdSheet As Worksheet
Set ProdSheet = ActiveWorkbook.Worksheets("Products")

Dim Brand, LastBrand, BrandList As Range
Set LastBrand = RefSheet.Range("A1").End(xlDown)
Set BrandList = RefSheet.Range(RefSheet.Range("A1"), LastBrand)

Dim Reference, ReferenceList, LastReference As Range
Set LastReference = ProdSheet.Range("C2").End(xlDown)
Set ReferenceList = ProdSheet.Range(ProdSheet.Range("C2"), LastReference)

Dim BrandInList As Boolean

'Part 1a - assigning brand references to product
For Each Brand In BrandList
For Each Reference In ReferenceList
    If InStr(1, Reference, Brand, 1) And IsEmpty(Reference.Offset(0, 1).Value) Then
        Reference.Offset(0, 1).Value = Brand.Offset(0, 1).Value
        BrandInList = True
    ElseIf Not IsEmpty(Reference.Offset(0, 1).Value) Then
        If InStr(1, Reference, Brand, 1) Then

        Reference.EntireRow.Insert
        Reference.Offset(1, 1).Value = Brand.Offset(0, 1).Value
        BrandInList = True
        End If
    Else
        BrandInList = False
    End If
Next Reference
Next Brand

End Sub

修改我正在寻找方法来改变代码以完全不使用循环或找到一种方法，以便excel不会崩溃，宏可以在不到5分钟的时间内运行..

EDIT2 我的reflist是一个包含单元格的列：

Howell Michigan
1234 Detroit Michigan
ABC Detroit Michigan
A Detroit Michigan
Ann Arbor Michigan
334 Ann Arbor Michigan
Amazing Howell & Detroit Kind

我的品牌列表如下所示：

column A       column b
Howell         Howell Michigan
Detroit        Detroit Michigan
Ann Arbor      Ann Arbor Michigan

该项目的目标是两部分：第1部分 - 如果参考单元包括A列中的内容，它将返回参考单元旁边的单元格b列中的任何内容。第2部分 - 如果有多个事件（例如Howell＆amp; Detroit），则返回参考单元格旁边的单元格中的第一列b值，然后插入新行并复制所有内容但放入第二列b值相反（因此，SPLIT）

Answer 1

当您在单元格中写入值时，Excel必须重绘您的屏幕。因此，当您在工作表中书写时，对您的代码有帮助的东西会关闭该功能。

在循环之前尝试此代码。

Application.Screenupdating = False

完成循环后别忘了再打开

Application.Screenupdating = True

另一种选择是使用范围数组的字符串整数数组肯定会更慢。例如，您可以在字符串范围内读取您的品牌列表范围，但我还没有对其进行测试，但我确定您是否在字符串数组中循环会更快

Answer 2

您可以尝试：

Sub Splitter_Step1a()

    Dim RefSheet As Worksheet
    Set RefSheet = ActiveWorkbook.Worksheets("RefList")
    Dim ProdSheet As Worksheet
    Set ProdSheet = ActiveWorkbook.Worksheets("Products")

    Dim Brand, LastBrand, BrandList As Range
    Set LastBrand = RefSheet.Range("A1").End(xlDown)
    Set BrandList = RefSheet.Range(RefSheet.Range("A1"), LastBrand)

    Dim Reference, ReferenceList, LastReference As Range
    Set LastReference = ProdSheet.Range("C2").End(xlDown)
    Set ReferenceList = ProdSheet.Range(ProdSheet.Range("C2"), LastReference)

    Dim BrandInList As Boolean, i As Integer

    Application.ScreenUpdating = False
    i = 0

    'Part 1a - assigning brand references to product
    For Each Brand In BrandList
        For Each Reference In ReferenceList
            If InStr(1, Reference, Brand, 1) And IsEmpty(Reference.Offset(0, 1).Value) Then
                Reference.Offset(0, 1).Value = Brand.Offset(0, 1).Value
                BrandInList = True
            ElseIf Not IsEmpty(Reference.Offset(0, 1).Value) Then
                If InStr(1, Reference, Brand, 1) Then

                Reference.EntireRow.Insert
                Reference.Offset(1, 1).Value = Brand.Offset(0, 1).Value
                BrandInList = True
                End If
            Else
                BrandInList = False
            End If
        Next Reference

        i = i + 1
        If i Mod 5 = 0 Then
            Application.StatusBar = "Working: " & i & "/" & UBount(BrandList) 'Update scree to show that the Sub is working
            DoEvents
        End If

    Next Brand
    Application.ScreenUpdating = True
End Sub

PS ：也许您可以在最后一行写入而不是InsertRow，最后可以再次对列进行排序。 InsertRow可能需要很长时间。

Answer 3

首先，多次使用excel评估表达式添加负载，因此尝试存储一些变量。第二，对于下一个循环在处理方面非常昂贵第三，我看到你使用BrandinList设置true和false但我不知道你是否使用它

Answer 4

不确定我是否完全理解，但您可以使用查找作为参考，只为您的品牌使用循环。这可能不完美，但有点像：

Sub Splitter_Step1a()
Dim i
Dim RefSheet As Worksheet
Set RefSheet = ActiveWorkbook.Worksheets("RefList")
Dim ProdSheet As Worksheet
Set ProdSheet = ActiveWorkbook.Worksheets("Products")

Dim Brand, LastBrand, BrandList As Range
Set LastBrand = RefSheet.Range("A1").End(xlDown)
Set BrandList = RefSheet.Range(RefSheet.Range("A1"), LastBrand)

Dim Reference, ReferenceList, LastReference As Range
Set LastReference = ProdSheet.Range("C2").End(xlDown)
Set ReferenceList = ProdSheet.Range(ProdSheet.Range("C2"), LastReference)

Dim BrandInList As Boolean

'Part 1a - assigning brand references to product
For Each Brand In BrandList
With ProdSheet.Range(ReferenceList)
    Set c = .Find(Brand, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        i = 0
        Do
            i = i + 1
            If i = 1 Then
                Reference.Offset(0, 1).Value = Brand.Offset(0, 1).Value
            Else
                Reference.EntireRow.Insert
                Reference.Offset(1, 1).Value = Brand.Offset(0, 1).Value
            End If
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
Next Brand

End Sub

也可能希望在开始时将application.calculation转为手动，然后在结束时将其重新打开。如果您在工作簿中有大量查找，则尤其如此。

优化循环代码超过100,000行

4 个答案: