广告
淘宝内部优惠券
当前位置: 开发异常方案库» VBA » 同样的代码运行多次竟然时间差距十几倍?

同样的代码运行多次竟然时间差距十几倍?

开发异常方案库  收集整理于:2020-05-27 22:46:00  浏览:66次
一个读取数据作图的宏。对同样的9个文件进行处理,刚开始一分钟或者三四分钟就能跑完,多run几次十几分钟下不来,后来甚至一个小时跑不完。 什么情况。
Public FC As Integer    'count for txt files
Public f As Variant
Public fcsv(10) As String
Public ind(10) As String
Public data(1 To 10, 1 To 4000) As String
Sub RTD()
Dim tm
tm = Now()
    
    'On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'clear contents
    Sheets("Charts").Activate
    Range(Cells(1, 2), Cells(4100, 100)).Select
    Selection.ClearContents
    
    'clear charts
    Dim b As ChartObject
    For Each b In ActiveSheet.ChartObjects
    b.Delete
    Next
    'get csv files name
    MsgBox "Compare the same station for different tools", 0, "Open file"
    
    'Get path/name of the response *.csv file
    f = Application.GetOpenFilename("Excel Files (*.csv), *.csv", 1, "Open csv files", "Oppp", True)
    
    FC = UBound(f)
    
    If FC = 1 Or FC > 10 Then
    MsgBox "Number of files should be less than or equal to 10 and greater than or equal to 2"
    Exit Sub
    End If
    'Open each  *.csv file
    For j = 1 To FC
        '1. Path
        lngStart = 1
        Do
            backslash = InStr(lngStart, f(j), "\")
            If backslash = 0 Then
                fcsv(j) = Right(f(j), Len(f(j)) - lngStart + 1)
            Else
                lngStart = backslash + 1
            End If
        Loop While backslash > 0
        '2. File name
        lngStart = 1
        dot = InStr(lngStart, fcsv(j), ".")
        ind(j) = Left(fcsv(j), dot - 1)
        
        Workbooks.Open f(j)
       
    Next j
Windows(ind(1)).Activate
URR = Application.CountA(ActiveSheet.Range("A:A"))
URC = Application.CountA(ActiveSheet.Range("1:1"))
p = 2
q = 1
For j = 1 To URC - 1
 
  
  'copy data from files
  Windows(ind(1)).Activate
  Yname = Cells(1, j + 1)
  For i = 1 To URR - 1
  data(1, i) = Cells(i + 1, j + 1)
  Next i
  For M = 2 To FC
  Windows(ind(M)).Activate
  URC2 = Application.CountA(ActiveSheet.Range("1:1"))
  URR2 = Application.CountA(ActiveSheet.Range("A:A"))
   For n = 1 To URC2
    If Cells(1, n) = Yname Then
      For i = 1 To URR2 - 1
      data(M, i) = Cells(i + 1, j + 1)
      Next i
      Exit For
    End If
   Next n
  Next M
  
  'paste data to "RTD CHARTS"
  Windows("RTD CHARTS").Activate
  For i = 1 To FC
    Cells(101, 1 + i - FC + FC * j) = Yname
    Cells(100, 1 + i - FC + FC * j) = ind(i)
    For M = 1 To URR2 - 1
    Cells(M + 101, 1 + i - FC + FC * j) = data(i, M)
    Next M
  Next i
  
'make Charts
    If j > 1 Then
    Cells(1, 1).Select
    
    If p = 7 Then
    p = 2
    q = q + 1
    End If
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers, Cells(2 + (q - 1) * 16, 2 + 8 * (p - 2)).Left, Cells(2 + (q - 1) * 16, 2 + 8 * (p - 2)).Top).Select
    p = p + 1
    
    ActiveChart.ChartTitle.Text = Cells(101, (j - 1) * FC + 3)
    For i = 1 To FC
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(i).Name = Cells(100, 1 + i)
    URR = Application.CountA(ActiveSheet.Range(Cells(1, i + 1), Cells(5000, i + 1)))
    ActiveChart.FullSeriesCollection(i).XValues = Range(Cells(102, i + 1), Cells(URR, i + 1))
    URR = Application.CountA(ActiveSheet.Range(Cells(1, 1 + i - FC + FC * j), Cells(5000, 1 + i - FC + FC * j)))
    ActiveChart.FullSeriesCollection(i).Values = Range(Cells(102, 1 + i - FC + FC * j), Cells(URR, 1 + i - FC + FC * j))
    Next i
    ActiveChart.SetElement (msoElementLegendBottom)
    End If
    
 Erase data()
Next j
'close the files one by one
For j = 1 To FC
     Windows(fcsv(j)).Activate
     ActiveWorkbook.Close SaveChanges:=False
Next j
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
MsgBox "Time-consuming is " & Format(Now() - tm, "hh:mm:ss")
End Sub

------网友观点--------------------
运行的时候按ctrl+break,看大部分时间停在哪里,那里就是最耗时的操作;
发布此文章仅为传递网友分享,不代表本站观点,若侵权请联系我们删除,本站将不对此承担任何责任。
软件开发 程序错误 异常 ybaby.netCopyright © 2020-2026  ybaby 版权所有  桂ICP备17004385号-2 网站地图