excel 更快地插入行和复制数据

b09cbbtk 于 2022-11-18 发布在其他

关注(0)|答案(1)|浏览(183)

我需要查找值和测试一些条件，并插入行到Excel工作表（文件重65 MB）。我有7个这样的工作表，我需要插入数据。同一文件内的参考数据表是75k+行（wsSrcREDW）
我的代码运行非常慢。有人可以请建议更快的算法。谢谢
编辑：运行真正慢的部分不是数组赋值而是最后插入行循环，查找新账户和插入信息需要5分钟以上。

Dim Curr() As String

For Each c In wsSrcREDW.Range("J2:J" & lrow1).Cells
    ReDim Preserve Curr(2 To c.Row)
    Curr(c.Row) = c.Value
Next c

Dim Entity() As String

For Each c In wsSrcREDW.Range("C2:C" & lrow1).Cells
    ReDim Preserve Entity(2 To c.Row)
    Entity(c.Row) = c.Value
Next c

Dim M9() As String

For Each c In wsSrcREDW.Range("F2:F" & lrow1).Cells
    ReDim Preserve M9(2 To c.Row)
    M9(c.Row) = c.Value
Next c


''' ECL Wback

Set wsECLWMBB = wbREDWMBB.Sheets("ECL WBack")
lrowECLWOrg = wsECLWMBB.Range("A" & Rows.Count).End(xlUp).Row

Dim I7() As String

For Each c In wsSrcREDW.Range("S2:S" & lrow1).Cells
    ReDim Preserve I7(2 To c.Row)
    I7(c.Row) = c.Value
Next c

For i = 2 To UBound(I7)
    Set c = wsECLWMBB.Range("B2:B" & lrowECLWOrg).Find(I7(i))
    If c Is Nothing And Entity(i) = "MIB" Then
        lrowECLW = wsECLWMBB.Range("A" & Rows.Count).End(xlUp).Row
        wsECLWMBB.Range("A" & (lrowECLW + 1)).EntireRow.Insert            
        wsECLWMBB.Range("A" & (lrowECLW + 1)).Value = M9(i)
        wsECLWMBB.Range("B" & (lrowECLW + 1)).Value = I7(i)
        wsECLWMBB.Range("C" & (lrowECLW + 1)).Value = Curr(i)
        wsECLWMBB.Range("D" & (lrowECLW + 1)).Formula = "=MID(B" & (lrowECLW + 1) & ",1,7)"
    End If
Next i

excel

来源：https://stackoverflow.com/questions/74414222/faster-way-to-insert-rows-and-copy-data

1条答案

按热度按时间

ndh0cuux1#

使用一个变量数组。在一次操作中填充并写入整个数组。下面的代码应该可以做到这一点。

Option Explicit

Sub TEST()

Dim dataSrcEDW As Variant, dataECLWMBB As Variant, dataNew As Variant
Dim wsSrcREDW As Worksheet, wsECLWMBB As Worksheet
Dim colEntity As Long, colCurr As Long, colM9 As Long, colI7 As Long
Dim iSrcRow As Long, iTargetRow As Long, iNewRow As Long
Dim bFound As Boolean
Dim rgNew As Range

dataSrcEDW = wsSrcREDW.Range("A1").CurrentRegion    ' Retrives all the source data
dataECLWMBB = wsECLWMBB.Range("A1").CurrentRegion   ' Retrieves all the target data

ReDim dataNew(0, 1 To 4) ' This will contain the new rows you are adding at the end of wsECLWMBB

' Identify the columnns of interest
colCurr = Asc("J") - 64: colEntity = Asc("C") - 64: colM9 = Asc("F") - 64: colI7 = Asc("S") - 64

For iSrcRow = 2 To UBound(dataSrcEDW, 1)    ' Scane through the source
    bFound = False
    If dataSrcEDW(iSrcRow, colEntity) = "MIB" Then
        For iTargetRow = 2 To UBound(dataECLWMBB, 1)
            If dataSrcEDW(iSrcRow, colI7) = dataECLWMBB(iTargetRow, 2) Then
                bFound = True
                Exit For
            End If
        Next
        If Not bFound Then  ' Check if this is a duplicate add
            For iNewRow = 1 To UBound(dataNew, 1)
                If dataSrcEDW(iSrcRow, colI7) = dataNew(iNewRow, 2) Then
                    bFound = True
                    Exit For
                End If
            Next
        End If
        If Not bFound Then
            dataNew = AddRowToArray(dataNew)
            iNewRow = UBound(dataNew, 1)
            dataNew(iNewRow, 1) = dataSrcEDW(iSrcRow, colM9)
            dataNew(iNewRow, 2) = dataSrcEDW(iSrcRow, colI7)
            dataNew(iNewRow, 3) = dataSrcEDW(iSrcRow, colCurr)
            dataNew(iNewRow, 4) = "=MID(B" & UBound(dataECLWMBB, 1) + iNewRow & ",1,7)"
       End If
    End If
Next
' Write out the new rows
    If UBound(dataNew, 1) > 0 Then
        Set rgNew = wsECLWMBB.Range("A" & UBound(dataECLWMBB, 1) + 1).Resize(UBound(dataNew, 1), UBound(dataNew, 2))
        rgNew = dataNew
    End If
End Sub

Public Function AddRowToArray(vArray) As Variant
    ' Can't do a redim preserve on a multi dimensional array.  Add a row manually.
    Dim vNewArray As Variant, iRow As Long, iCol As Long
            
    ReDim vNewArray(1 To UBound(vArray, 1) + 1, 1 To UBound(vArray, 2))
    
    For iRow = 1 To UBound(vArray, 1)
        For iCol = 1 To UBound(vArray, 2)
            vNewArray(iRow, iCol) = vArray(iRow, iCol)
        Next
    Next
    AddRowToArray = vNewArray
End Function

赞(0）回复(0）举报 2022-11-18

我来回答

excel 更快地插入行和复制数据

1条答案

相关问题

热门标签

最新问答