string函数MID是否有更好的实现,或者VBA的更好的实现方式更快

我有脚本调用“MID”(16N)次,当N = 43时需要大约4分钟的执行时间。我不知道为什么它需要这么长时间,每次调用的string为〜440个字符:

Sub Button1_Click() If Sheets.count = 1 Then a = ActiveWorkbook.Name ChDir "C:\" MsgBox "Be Prepared to a text file", vbExclamation, _ Application.ScreenUpdating = False Application.Calculation = xlCalculationManual FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt") Workbooks.OpenText FileToOpen, Origin:=xlWindows, _ StartRow:=1, DataType:=xlDelimited, Tab:=True x = ActiveWorkbook.Name 'SO # workbook Workbooks(x).Sheets(1).Copy after:=Workbooks(a).Sheets(1) ActiveSheet.Name = "Results" Windows(x).Activate 'SO # workbook ActiveWorkbook.Close 'I also need to declare the value of each column with each 'with' statement Range("A1").Select With Rows("1:1") .Insert Shift:=xlDown End With With Range("A1") .Font.Bold = True End With 'Columns("A:A").EntireColumn.AutoFit With Range("B1") .Font.Bold = True End With Columns("B:B").EntireColumn.AutoFit With Range("C1") .Font.Bold = True End With Columns("C:C").EntireColumn.AutoFit With Range("D1") .Font.Bold = True End With Columns("D:D").EntireColumn.AutoFit With Range("E1") .Font.Bold = True End With Columns("E:E").EntireColumn.AutoFit With Range("F1") .Font.Bold = True End With Columns("F:F").EntireColumn.AutoFit With Range("G1") .Font.Bold = True End With Columns("G:G").EntireColumn.AutoFit With Range("H1") .Font.Bold = True End With Columns("H:H").EntireColumn.AutoFit With Range("I1") .Font.Bold = True End With Columns("I:I").HorizontalAlignment = xlLeft Columns("I:I").EntireColumn.AutoFit With Range("J1") .Font.Bold = True End With Columns("J:J").EntireColumn.AutoFit With Range("K1") .Font.Bold = True End With Columns("K:K").EntireColumn.AutoFit With Range("L1") .Font.Bold = True End With Columns("L:L").EntireColumn.AutoFit With Range("M1") .Font.Bold = True End With Columns("M:M").EntireColumn.AutoFit With Range("N1") .Font.Bold = True End With Columns("N:N").EntireColumn.AutoFit With Range("O1") .Font.Bold = True End With Columns("O:O").EntireColumn.AutoFit With Range("P1") End With Selection.Font.Bold = True Columns("P:P").EntireColumn.AutoFit With Range("Q1") .Font.Bold = True End With Columns("Q:Q").EntireColumn.AutoFit Dim i As Long Dim current As String 'Dim Strings As Variant Dim count As Integer Dim cell As Integer Set rng = Range(Cells(1, 1), Cells(Rows.count, 16)) For i = 2 To Rows.count 'foreach row current = Cells(i, 1).Value cell = 0 '0 rng(i, cell + 1).Value = Mid(current, 3, 7) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 9, 7) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 16, 5) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 40, 10) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 50, 8) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 58, 8) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 66, 4) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 70, 2) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 100, 20) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 120, 6) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 126, 10) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 136, 10) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 146, 12) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 158, 12) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 170, 12) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 194, 255) cell = cell + 1 rng(i, cell + 1).Value = Mid(current, 449, 255) cell = cell + 1 Next i ActiveSheet.ListObjects.Add(xlSrcRange, Range(rng(1, 1), rng(Rows.count, cell)), , xlYes).Name = _ "Table1" ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight2" Application.ScreenUpdating = True MsgBox "Macro has finished running" MsgBox "Data is now in Excel format and can be saved to a new file.", _ vbExclamation, "MORE CHOICES" Application.Calculation = xlCalculationAutomatic Else MsgBox "Additional tab already exists. Only MACROS tab should exist in workbook prior to running macro.", _ vbExclamation, "** Additional tab already exists **" End If End Sub 

我一直使用这个来源作为参考,试图减less所需的时间。

有任何想法吗?

在即时窗口(Ctrl + G)中,键入:

 ? Rows.Count 1048576 

这是你循环的行数。

无论你在哪里使用Rows.CountRows.Count用这个:

 ActiveSheet.UsedRange.Rows.Count 

或者将其分配给一个LongvariablesnumRows并使用它。

debuggingVBA代码将帮助find问题,在循环中有一个断点。

不,没有更好的实现,但是你应该知道Mid()返回一个Variant ,然后你的代码使用隐式转换来返回String版本。

如果你使用这个函数的string版本: Mid$() (注意美元符号),那么返回types是显式的,并且总是以stringforms返回。 在高级代码中,这可以稍微快一些。