VBA Macro se bloque après 32000 lignes

J'ai une macro VBA qui copie les lignes d'une feuille de calcul dans une autre basée sur la recherche de valeurs dans les cellules en 3 colonnes. La macro fonctionne, mais se bloque lorsqu'il atteint la ligne 32767. Il n'y a pas de formules ou de mise en forme spéciale de cette ligne. De plus, j'ai pris la ligne, mais il se bloque toujours sur la ligne de nombre. Est-ce une limitation dans excel? Il y a quelques 43000 dans la feuille de calcul en cours de processus

Par conséquent, je demande quel est le problème avec ma macro et comment je peux l'obtenir à atteindre la fin de la feuille de calcul:

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

Pour Chaque wks Dans des Feuilles de calcul

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."

S'il vous plaît aider!

source d'informationauteur Andy5 | 2012-05-11

32

Le VBA 'Int' type est signé de 16 bits du champ de sorte qu'il ne peut contenir que des valeurs de -32768 à +32767. Modifier les variables de "Long", qui est un 32-bit signé champ et peuvent contenir des valeurs de -2147483648 à +2147483647. Devrait être suffisant pour Excel. 😉
5

Cela sonne comme un entier Problème

La Entier et des types de données Long peut à la fois tenir positif ou négatif
des valeurs. La différence entre eux, c'est leur taille: Entier variables
peut contenir des valeurs entre de -32 768 et 32 767, alors que les variables peuvent
plage de -2 147 483 648 à 2 147 483 647.

Mais quelle version utilisez-vous? Parce que:

Traditionnellement, VBA
les programmeurs ont utilisé des entiers de tenir un petit nombre, parce qu'ils
moins de mémoire. Dans les versions récentes, cependant, VBA convertit tous les
les valeurs de nombre entier de type Long, même si elles sont déclarées comme type
Entier. Par conséquent, il n'est plus un avantage de performance à
en utilisant des variables de type Entier; en fait, depuis Longtemps, les variables peuvent être légèrement
plus vite, parce que VBA ne pas avoir à les convertir.

Cette Information est directement à partir de MSDN

Mise à JOUR

Veuillez également lire le premier commentaire! J'ai été l'interprétation de la MSDN de l'Information dans le mauvais sens!

C'est MSDN trompeur: VBA n'est pas elle-même les convertir en Entier
Long. Sous les couvertures le PROCESSEUR convertit en entier à la longue , ne l'
l'arithmétique et les convertit ensuite le résultant de long dos entier. Donc
VBA entiers ne peut toujours pas tenir les numéros de plus de 32K – Charles
Williams

Vous pouvez éviter l'Entier vs. Long problème en utilisant un Pour Chaque plutôt que l'incrémentation de lignes. Pour Chacun d'eux est généralement plus rapide, est d'éviter la Sélection de Plages. Voici un exemple:

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

Vous devez vous connecter pour publier un commentaire.