Ayuda en la programación, respuestas a preguntas / Sobresalir / Excel VBA: una manera eficiente de comparar fechas en bucles grandes - excel, vba, excel-vba

Excel VBA: forma eficiente de comparar fechas en bucles grandes - excel, vba, excel-vba

Descripción del programa

Estoy tratando de hacer Sub para hacer las cuentas de muchosarchivos. Cada archivo consta de filas ordenadas por fecha, y no hay un número fijo de estos. Algunos obtuvieron solo 300, otros superaron los 10 000. Cada fila está dividida en módulos, con una descripción de algunos problemas, también hay una suma de todas las columnas en cada módulo. Raport debe indicar cuántos problemas de ciertos módulos han aparecido a lo largo del tiempo establecidos por el usuario, en ciertos archivos también verificados por el usuario.

Problema

Mi Sub funciona, pero no estoy seguro de si lo estoy haciendocorrectamente. Para un archivo, la operación toma alrededor de 6 segundos, pero a veces es casi 2 minutos (5000 bucles por archivo en el bucle más grande), es bastante largo. Estoy casi seguro de que hay formas más eficientes de hacer el trabajo . Supongo que el principal problema es la forma en que estoy marcando la fecha en cada fila, también es el bucle más largo. Después de una lectura:

Realmente no entiendo cómo postular aquí. Filtrar o Encontrar Funciones, también estaba intentando con Arrays y Para cada, pero las ejecuciones en el tiempo fueron casi iguales (a veces mejor, a veces no). También creo que muchos Si "s y los bucles anidados pueden ralentizarse Sub abajo. Tal vez hay algunos bucles paralelos o uso del hilo en Excel VBA para acelerarlo? Creo que Excel siempre usa solo el 25% del procesador. También mi intento de darle al usuario una pequeña oportunidad de configurar el alcance del bucle (Numero 1 y Número 2 en Código) reduce el tiempo de 2 minutos a 30 segundos con una buena configuración, pero los archivos de DataBase se deben revisar y limpiar de vez en cuando, por lo que no es la mejor solución.

Estoy empezando a programar y es mi primer gran proyecto, así que soy consciente de la mala calidad del código. Espero que puedas guiarme un poco para hacer que esta tortuga sea más rápida. Lo siento por largo post.

Código

Es bastante grande, así que borré una paz no tan importante (se describe).

Sub CopyInfo()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Sheets("Silnik").Select

"Cleaning cells for raporting (they need to be empty)
Call Czyść

"Variable for storing data value
Dim Value

"Timer - to see how long it takes
Dim t As Single
t = Timer

"Variables for opening and closing scope of checking data (editable by the user)
Dim Data1, Data2
Data1 = Cells(3, 9).Value
Data2 = Cells(4, 9).Value

"Position of cells in raport can change (P - row, P2 - column), easy edit
Dim Postion, Position2
Position = 9
Position2 = 13

"With row should I start looking (N1)? How many rows should I look for dates (N2)?
"Get search scope values from sheet (these cells are editable by the user)
Dim Number1, Number2
Number1 = ActiveWorkbook.Sheets("Silnik").Cells(2, 28)
Number2 = ActiveWorkbook.Sheets("Silnik").Cells(3, 28)

"With files should I test? Do I need to test all of them, or just few (LiniaStany)
"Check state of the file (user can edit with file hes testing)
"Also - get names of the files (LiniaNazwy) - they can change in time
Dim LiniaStany(16), LiniaNazwy(16)
For i = 0 To 15
LiniaStany(i) = ActiveWorkbook.Sheets("Silnik").Cells(2 + i, 22)
LiniaNazwy(i) = ActiveWorkbook.Sheets("Silnik").Cells(2 + i, 21)
Next

"Variables for workbooks
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
"Set current workbook (to this file)
Set wb = ActiveWorkbook


"Core
"i means currently opened file
For i = 0 To 15
"Check if file should be tested, if yes, then set FilePath and open
If (LiniaStany(i) > 0) Then
vFile = "C:UsersKrisDesktopkontrol " & LiniaNazwy(i) & " M.xlsm"
Workbooks.Open vFile
"Set DataBase workbook
Set wb2 = ActiveWorkbook
"Number is currently tested row in chosen file
For Number = Number1 To Number2
Value = wb2.Worksheets("Baza").Cells(6 + Number, 1)
"Check if date is in the scope
If (Value >= Data1) And (Value <= Data2) Then
"Get information about SUM of problems in "module1"
wb.Sheets("Wyniki").Cells(Position - 1, 4 + i * 3) = wb.Sheets("Wyniki").Cells(Position - 1, 4 + i * 3) + wb2.Worksheets("Baza").Cells(6 + Number, 80)
"Check if problems>0, if yes, get more informations
If (wb2.Worksheets("Baza").Cells(6 + Number, 80).Value > 0) Then
For WK = 0 To 17
wb.Sheets("Wyniki").Cells(Position + WK, 4 + i * 3).Value = wb.Sheets("Wyniki").Cells(Position + WK, 4 + i * 3).Value + wb2.Worksheets("Baza").Cells(6 + Number, Position2 + WK).Value
Next WK
End If
"Get information about SUM of problems in "module2"
wb.Sheets("Wyniki").Cells(Position + 18, 4 + i * 3) = wb.Sheets("Wyniki").Cells(Position + 18, 4 + i * 3) + wb2.Worksheets("Baza").Cells(6 + Number, 82)
If (wb2.Worksheets("Baza").Cells(6 + Number, 82).Value > 0) Then
For ZAP = 0 To 9
"ZAP - Detale
wb.Sheets("Wyniki").Cells(Position + ZAP + 18, 4 + i * 3).Value = wb.Sheets("Wyniki").Cells(Position + ZAP + 18, 4 + i * 3).Value + wb2.Worksheets("Baza").Cells(6 + Number, Position2 + ZAP + 17).Value
Next ZAP
End If
"Some more ifs (7)..., same way, cut out
"...
"...
End If
"See if row is empty or not - if yes, stop the main loop
If (Value < 1) Then
Exit For
End If
Next Number
"Close DataBase workbook, go to another one
wb2.Close False
End If
Next

Sheets("Raport").Select
Application.ScreenUpdating = screenUpdateState
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = eventsState

Beep
MsgBox "Operation time: " & Timer - t & " seconds."

End Sub

Respuestas

0 para la respuesta № 1

Como descubrí después de un tiempo, NO HAY NECESIDAD de comparar fechas Me gusta esto en bucle. Nunca. Excel proporciona filtros, que se pueden usar para reducir el rango de celdas solo a estos, que cumplen con ciertos criterios, que se describen en el filtro. La forma más fácil de hacer esto, es encender la grabadora de macros y establecer el filtro en el rango de celdas. El código debería tener este aspecto (después de inyectar dateStart y dateEnd):

With Sheet1

.AutoFilterMode = False

.Range("A1:D1").AutoFilter

.Range("A1:D1").AutoFilter Field:=2, Criteria1:=">=dateStart", _

Operator:=xlAnd, Criteria2:="<=dateEnd"

End With

Pero, si pasamos de un rango a otro con este filtro, todavía obtendremos los mismos resultados. Para que sea eficiente, solo debemos usar celdas visibles (filtradas). Para lograr esto podemos utilizar células especiales:

Set rng = Range("A2:D50")

For Each cl In rng.SpecialCells(xlCellTypeVisible)
"Do something on cells in date range
Next cl

Después de reemplazar el bucle externo con este método, sues posible filtrar otras opciones, de diferentes columnas (agregar diferentes filtros con diferentes campos y criterios). De esta manera, no hay necesidad de usar para bucles en absoluto. Con estos métodos es posible reducir el tiempo. De minutos a pocos segundos.