Question

我有调用＆＃39; MID＆＃39; （16N）次，当N = 43时执行大约需要4分钟。我不知道为什么它需要这么长时间才能调用每次约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

我一直在使用this来源作为参考，试图减少所需的时间。

有什么想法吗？

Answer 1

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

如果您使用此函数的字符串版本：Mid$() （请注意美元符号），则返回类型为显式，并始终以字符串形式返回。在高代码重复时，可以稍快一些。

Answer 2

在立即窗口（Ctrl + G）中，键入：

? Rows.Count
1048576

这是你要循环的行数。

无论您使用Rows.Count的哪个地方，请改用：

ActiveSheet.UsedRange.Rows.Count

或将其分配给Long变量numRows并使用它。

Debugging VBA Code可以帮助找到问题，循环中有一个断点。

是否有更好的字符串函数MID实现，或者更快的VBA实现更好的实现方式

2 个答案: