VBA Macro se bloquea después de 32000 filas

Question

Tengo una macro de VBA que copia las filas de una hoja de cálculo en otra según los valores encontrados en las celdas en 3 columnas. La macro funciona, pero se bloquea cuando alcanza la fila 32767. No hay fórmulas ni formateo especial en esta fila. Además, he sacado esa fila, pero todavía falla en ese número de fila. ¿Es esto una limitación en Excel? Hay algunos 43000 de la hoja que está siendo proceso

Por lo tanto, pido lo que está mal con mi macro y cómo lo puedo conseguir llegar al final de la hoja de trabajo:

Dim LSearchRow As Integer 
Dim LCopyToRow As Integer 
Dim wks As Worksheet 
On Error GoTo Err_Execute 

Para Cada semanas en las hojas de

LSearchRow = 4 
LCopyToRow = 4 

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
Set wksCopyTo = ActiveSheet 
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3) 

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0 

    If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then 

     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Copy 


     wksCopyTo.Select 
     wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
     wksCopyTo.Paste 

     'Move counter to next row 
     LCopyToRow = LCopyToRow + 1 
     'Go back to Sheet1 to continue searching 
     wks.Select 
    End If 
    LSearchRow = LSearchRow + 1 
Wend 

Application.CutCopyMode = False 
Range("A3").Select 
MsgBox "All matching data has been copied." 
Next wks 
    Exit Sub 
Err_Execute: 
    MsgBox "An error occurred." 

Por favor ayuda!

Answer 1

El tipo 'Int' de VBA es un campo de 16 bits con signo por lo que solo puede contener valores de -32768 a +32767. Cambie esas variables a 'Largo', que es un campo firmado de 32 bits y puede contener valores de -2147483648 a +2147483647. Debería ser suficiente para Excel. ;)

Answer 2

Esto suena como un problema de número entero

El Entero y tipos de datos largos pueden contener tanto positivos o negativos valores. La diferencia entre ellos es su tamaño: las variables enteras pueden contener valores entre -32,768 y 32,767, mientras que las variables Long pueden oscilar entre -2,147,483,648 y 2,147,483,647.

¿Pero qué versión estás usando? Porque:

Tradicionalmente, VBA programadores han utilizado números enteros para contener pequeñas cantidades, ya que requiere menos memoria. Sin embargo, en versiones recientes, VBA convierte todos los valores enteros para escribir Long, incluso si se declaran como tipo Entero. Por lo tanto, ya no existe una ventaja de rendimiento en usando variables enteras; de hecho, las variables largas pueden ser ligeramente más rápidas porque VBA no tiene que convertirlas.

esta información es directamente desde MSDN

ACTUALIZACIÓN

Lea también el primer comentario! Estaba interpretando la información de MSDN de la manera incorrecta.

Eso es MSDN ser engañoso: VBA no convierte a Integer en sí mismo a Long. Debajo de las cubiertas, la CPU convierte el entero a largo, realiza la aritmética y luego convierte el largo resultante en entero. Así VBA enteros aún no pueden mantener un número mayor que 32 K - Charles Williams

Answer 3

Puede evitar el problema de enteros vs largo mediante el uso de un For Each en lugar de incrementar filas. Para cada uno es generalmente más rápido, como lo es evitar la selección de rangos.Aquí hay un ejemplo:

Sub CopySheets() 

    Dim shSource As Worksheet 
    Dim shDest As Worksheet 
    Dim rCell As Range 
    Dim aSheets() As Worksheet 
    Dim lShtCnt As Long 
    Dim i As Long 

    Const sDESTPREFIX As String = "dest_" 

    On Error GoTo Err_Execute 

    For Each shSource In ThisWorkbook.Worksheets 
     lShtCnt = lShtCnt + 1 
     ReDim Preserve aSheets(1 To lShtCnt) 
     Set aSheets(lShtCnt) = shSource 
    Next shSource 

    For i = LBound(aSheets) To UBound(aSheets) 
     Set shSource = aSheets(i) 

     'Add a new sheet 
     With ThisWorkbook 
      Set shDest = .Worksheets.Add(, .Worksheets(.Worksheets.Count)) 
      shDest.Name = sDESTPREFIX & shSource.Name 
     End With 

     'copy header row 
     shSource.Rows(3).Copy shDest.Rows(3) 

     'loop through the cells in column a 
     For Each rCell In shSource.Range("A4", shSource.Cells(shSource.Rows.Count, 1).End(xlUp)).Cells 
      If Not IsEmpty(rCell.Value) And _ 
       rCell.Offset(0, 27).Value = "Yes" And _ 
       rCell.Offset(0, 36).Value = "Yes" And _ 
       rCell.Offset(0, 53).Value = "Yes" Then 

       'copy the row 
       rCell.EntireRow.Copy shDest.Range(rCell.Address).EntireRow 
      End If 
     Next rCell 
    Next i 

    MsgBox "All matching data has been copied." 

Err_Exit: 
    'do this stuff even if an error occurs 
    On Error Resume Next 
    Application.CutCopyMode = False 
    Exit Sub 

Err_Execute: 
    MsgBox "An error occurred." 
    Resume Err_Exit 

End Sub