我正在尝试改进一些我没写过的代码,主要是为了让其他人更容易理解(我发现它真的很奇怪)。我尝试重写它,它基本上做同样的事情,使用大致相同的过程。
然而旧版本需要2分钟才能运行我记录的一些数据。另一个需要花费一个多小时来处理相同的数据。到底是怎么回事?
他们使用的数据格式是:
编辑:我应该添加,我会使用字典,因为我认为它们会最快,除了“TextX”的数量基本上是随机的。有时只出现Text1。有时它会一直到Text20或更多。
(抱歉代码即将发布,如果我的图片链接格式错误,请对不起 - 以前从未这样做过)
旧代码:
sub DivideSheet() Application.ScreenUpdating = False Dim name As String Dim point_name As String Dim SheetCount, sheetNumber As Integer Dim RowCount, RowStart As Long Dim Exist, RowEmpty As Boolean Sheets("RAW DATA").Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(12, 1), Array(13, 1), Array(22, 1), Array(23, 1), Array(27, 1), _ Array(31, 1), Array(36, 1)), TrailingMinusNumbers:=True Exist = False RowCount = 1 RowStart = 1 SheetCount = 1 point_name = Worksheets(1).Cells(1, 3) For RowCount = 1 To 1048576 'loop through all the rows in the sheet If CStr(Sheets(1).Cells(RowCount, 3)) = "" Then 'If the cell isnt a new transmition 'do nothing ElseIf CStr(Sheets(1).Cells(RowCount, 3)) = point_name Then 'If the new transmition is from the same node 'Do nothing Else 'If its a new node For SheetCount = 1 To Sheets.Count 'loop through sheets If Worksheets(SheetCount).name = point_name Then 'If the sheet name matches point_name Exist = True 'set flag to true sheetNumber = SheetCount 'Record Sheet number Exit For 'Exit the for loop End If Next SheetCount If Exist = False Then 'If the Node didnt have a sheet sheetNumber = SheetCount Worksheets.Add After:=Worksheets(SheetCount - 1) 'Create a sheet Worksheets(Sheets.Count).name = point_name 'Name it for the RTU End If Call CopyLine(sheetNumber, RowStart, RowCount - 1) 'Call the Copying function to copy the chunk of data RowStart = RowCount 'Set a new start point for the next chunk of data point_name = Worksheets(1).Cells(RowCount, 3) 'Set the Node the chunk of data will belong to SheetCount = 1 'Reset Variable Exist = False 'Reset Variable End If Next RowCount SheetCount = 1 'Resets the SheetCount Variable For SheetCount = 1 To Sheets.Count 'Loops through Sheets Sheets(SheetCount).Columns("H:H").EntireColumn.AutoFit 'Autofits the H column Next SheetCount End Sub Public Sub CopyLine(sheetNumber As Integer, RowStart As Long, rowNumber As Long) If Sheets(sheetNumber).Range("A1").Value = "" Then 'If its the first data to enter the sheet 'Copy the chunk of data Sheets(1).Range("a" & RowStart, "h" & rowNumber).Copy _ Destination:=Sheets(sheetNumber).Range("A1", Cells(rowNumber - RowStart + 1, "H")) ElseIf Sheets(sheetNumber).Range("H2").Value = "" Then 'If its the Second data to enter the sheet 'Copy the chunk of data Sheets(1).Range("a" & RowStart, "h" & rowNumber).Copy _ Destination:=Sheets(sheetNumber).Range("A2", Cells(rowNumber - RowStart + 2, "H")) Else 'otherwise 'Copy the chunk of data Sheets(1).Range("a" & RowStart, "h" & rowNumber).Copy _ Destination:=Sheets(sheetNumber).Range("h1048576").End(xlUp).Offset(1, -7) End If End Sub
和我的代码......
sub DivideSheet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Point As String
Set wb1 = ThisWorkbook
wb1.Sheets("RAW DATA").Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(12, 1), Array(13, 1), Array(22, 1), Array(23, 1), Array(27, 1), _
Array(31, 1), Array(36, 1)), TrailingMinusNumbers:=True
'loop through all the rows in the sheet
For i = 1 To wb1.Sheets(1).UsedRange.Rows.Count
Point = wb1.Sheets(1).Cells(i, 3)
If wb1.Sheets(1).Cells(i, 3) <> "" Then
a = sheetexists(Point)
If a Then
Call CopyLine(a, i, Point)
Else
wb1.Sheets.Add after:=wb1.Sheets(Sheets.Count)
wb1.Sheets(Sheets.Count).name = Point
Call CopyLine(wb1.Sheets.Count, i, Point)
wb1.Sheets(Sheets.Count).Rows(1).Delete
End If
End If
Next i
For Each wsh In wb1.Sheets 'Loops through Sheets
wsh.Columns.AutoFit 'Autofits everything
Next wsh
End Sub
Public Sub CopyLine(a, i, Point)
Set wb1 = ThisWorkbook
j = i + 1
While (wb1.Sheets(1).Cells(j, 3) = "" Or wb1.Sheets(1).Cells(j, 3) = Point) And j <= wb1.Sheets(1).UsedRange.Rows.Count 'WorksheetFunction.CountA(wb1.Sheets(1).Rows(i)) = 0
j = j + 1
Wend
wb1.Sheets(1).Range(wb1.Sheets(1).Cells(i, 1), wb1.Sheets(1).Cells(j - 1, 8)).Copy Destination:=wb1.Sheets(a).Cells(wb1.Sheets(a).UsedRange.Rows.Count, 1).Offset(1, 0)
i = j - 1
End Sub
Function sheetexists(Point)
Dim a As Integer
Set wb1 = ThisWorkbook
sheetexists = 0
For a = 1 To wb1.Sheets.Count
If wb1.Sheets(a).name = Point Then
sheetexists = a
Exit Function
End If
Next a
End Function
我不是疯了,对吧?这两者之间没有根本的区别,除了我的线路更少,更少迂回,而且通常不浪费?那么为什么我的新代码需要更长的时间呢?