A macro, read the data mapping to deal with the same 9 files, start a minute or three or four minutes to run, run a few times more ten minutes come down, even an hour later to run out,
What circumstance,

 Public FC As Integer 'count for TXT files 
The Public As the Variant f 
Public FCSV (10) As String 
Public ind (10) As String 
Public data (1 To 10, 1 To 4000) As the String 


Sub RTD () 
Dim tm 
Tm=Now () 

'On the Error Resume Next 
Application. ScreenUpdating=False 
Application. DisplayAlerts=False 

'the clear contents 
Sheets (" Charts "). Activate 
Range (Cells (1, 2), Cells (4100, 100)). Select 
Selection. ClearContents 

'the clear charts 
Dim As ChartObject b 
For Each b In ActiveSheet. ChartObjects 
B.D elete 
Next 

'get the CSV files name 
MsgBox "Compare the same station for company's tools", 0, "Open file" 

'Get the path/name of the response *. CSV file 
F=Application. GetOpenFilename (" Excel Files (*. CSV), *. CSV ", 1, "Open the CSV Files", "Oppp", True) 

FC=UBound (f) 

If FC=1 Or FC & gt; 10 Then 
MsgBox "the Number of files should be less than or equal to 10 and greater than or equal to 2" 
The Exit Sub 
End the If 

'Open the each *. CSV file 
For j=1 To FC 
'1. Path 
LngStart=1 
Do 
The backslash=InStr (lngStart, f (j), "") 
If the backslash=0 Then 
FCSV (j)=Right (f (j), Len (f (j)) - lngStart + 1) 
The Else 
LngStart=backslash + 1 
End the If 
Loop While backslash & gt; 0 
'2. The File name 
LngStart=1 
The 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 ")) 
P=2 
Q=1 
For j=1 To URC - 1 


'copy the 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 ")) 
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 
The Exit For 
End the If 
The Next n 
Next M 

'the 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 & gt; 1 Then 
Cells (1, 1). Select 

If p=7 Then 
P=2 
Q=q + 1 
End the If 
ActiveSheet. Shapes. AddChart2 (240, xlXYScatterSmoothNoMarkers, Cells (2 + 1 (q) * 16, 2 + 8 * (p - 2)). The Left, the Cells (2 +) (q - 1 * 16, 2 + 8 * (p - 2)). The 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). The 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). The Values=Range (Cells (102, 1 + I - FC + FC * j), Cells (URR, 1 + I - FC + FC * j)) 
Next I 
ActiveChart. SetElement (msoElementLegendBottom) 
End the If 

Erase the 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" & amp; The Format (Now () - tm, "hh: mm: ss") 
End Sub 

CodePudding user response:

Run time press CTRL + break, see where most of the time stop, there is the most time-consuming operation;

CodePudding user response:

Perform a few times, you Excel file is bigger, this may be the reason

CodePudding user response:

Big load calculation is best VB6