Question

我有一个代码，每月需要在500.000行的Excel数据库上运行。代码遍历1个包含不同Owber的整个数据库，并将其拆分为不同的选项卡-如果它们最初不存在，则创建它们。对我来说，对代码进行编码，创建和使它工作起来是一个新手，这对我来说是一个巨大的成功，但是要遍历整个电子表格（5分钟/ 10.000条记录-整个电子表格大约3-5小时）要花很多时间。有没有人可以看一下，也许可以使其工作更快？我对理解数组不好，但是我认为对它们进行处理可以使它更好地工作。

对不起，编码错误：

`

'Loop through spreadsheet and create new tabs if needed

Sub Copy_To_Tab()
Dim Main As Worksheet
Dim a, LR, LR2, LR3 As Integer
Dim Sht As String

Set Main = Sheets(1)

Application.ScreenUpdating = False

a = 2
LR = Main.Range("A" & Rows.Count).End(xlUp).Row

Do Until a > LR
ponownie:
        Sht = Main.Range("R" & a).Value
        If Sht = "" Then GoTo drugi:
        On Error Resume Next
        LR2 = Sheets(Sht).Range("A" & Rows.Count).End(xlUp).Row + 1
        If Err.Number = 9 Then GoTo stworz:
        Main.Range("A" & a & ":AB" & a).Copy Sheets(Sht).Range("A" & LR2)
drugi:
    If Main.Range("R" & a).Value <> Main.Range("S" & a).Value Then
ponownie2:
        Sht2 = Main.Range("S" & a).Value
        If Sht2 = "" Then GoTo nastepny:
        On Error Resume Next
        LR3 = Sheets(Sht2).Range("A" & Rows.Count).End(xlUp).Row + 1
        If Err.Number = 9 Then GoTo stworz2:
        Main.Range("A" & a & ":AB" & a).Copy Sheets(Sht2).Range("A" & LR3)
    End If
nastepny:

a = a + 1
Loop
Application.ScreenUpdating = True
MsgBox "Finished"
Exit Sub

stworz:
CreateSheet (Sht)
GoTo ponownie:

stworz2:
CreateSheet (Sht2)
GoTo ponownie2:

End Sub

'Create new worksheet and name it
Sub CreateSheet(Nazwa As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = Nazwa
    Sheets(1).Range("A1:AZ1").Copy ws.Range("A1")
End Sub

`

Excel VBA中大文件上的代码缓慢，如何使其更快？

0 个答案: