J'ai trouvé ce code dans un fil précédent. Il insère une ligne vide après une modification des données.
La voici:
loop while not cells (irow,iCol).text=""
Cela fonctionne très bien, mais à cause de cette partie:
sub AddBlankRows()
'
dim iRow as integer, iCol as integer
dim oRng as range
set oRng=range("a1")
irow=oRng.row
icol=oRng.column
do
'
if cells(irow+1, iCol)<>cells(irow,iCol) then
cells(irow+1,iCol).entirerow.insert shift:=xldown
irow=irow+2
else
irow=irow+1
end if
'
loop while not cells (irow,iCol).text=""
'
end sub
Il cesse de fonctionner sur les lignes vides. J'en ai besoin pour ignorer les lignes vides et ne s'arrêter que lorsqu'il n'y a plus de données dans la plage. Des idées? Je suis très novice en programmation!
Ensuite, j'ai mis le code pour insérer une ligne vide entre chaque changement de données dans la 1ère colonne. Maintenant, je dois exécuter un deuxième code qui insérerait une ligne vide entre chaque changement de données dans la 3ème colonne, donc cela ressemblerait à ceci:
4 Réponses :
La dernière ligne d'une colonne qui contient des données est trouvée par la ligne classique:
LOOP UNTIL irow>cells(rows.count,icol).end(xlUp).Row
(où icol a le sens qu'il fait dans votre code). Ensuite, vous pouvez très simplement "Boucler sans iRow> lastrownum".
Cependant, vous introduisez un problème avec votre autre code, qui insère des lignes vides et déplace ainsi la "dernière ligne" toujours vers le bas. Vous devez donc vérifier la dernière ligne à chaque boucle. C'est en fait un code plus simple, qui utilise juste quelques ms de plus par boucle. Vous n'avez rien d'autre à faire que de changer la ligne LOOP en:
Dim lastrownum as integer lastrownum = cells(rows.count,icol).end(xlUp).Row
Désolé, mais je suis encore si nouveau dans ce domaine - pouvez-vous préciser comment j'intégrerais cela dans le code original ci-dessus?
Modification de la réponse pour donner une instruction spécifique. Heureusement, en fait, comme j'ai oublié le code doit vérifier la dernière ligne après chaque boucle.
Merci de m'aider ... D'accord! Donc tout ce que j'ai fait est de remplacer la ligne "Loop While Not" dans le code d'origine par votre ligne "Loop Until". Maintenant, je reçois l'erreur "Overflow"
Peut-être que cela aidera à ajouter: je répète le code complet 6 fois (pour qu'il s'applique à 6 feuilles de données différentes)
On dirait que votre boucle est infinie. L'autre réponse utilise l'autre approche, pour simplement ajouter 1 au nombre "lastrow" pour chaque insert. Vous pouvez essayer ça. Vous pouvez ajouter une commande MSGBOX ("Row:" & irow) 'au-dessus de la BOUCLE afin que vous puissiez regarder le nombre augmenter. Il pourrait être bon de faire cela, découvrez comment fonctionne le code.
La ligne commentée Cells (iRow + 1, cCol) .Interior.ColorIndex = 3 ajoute une couleur rouge dans la première cellule du ligne ajoutée qui aide beaucoup à essayer de comprendre un tel code.
Sub AddBlankRows2()
Const cCol As Variant = "A,C"
Const cFirstR As Long = 1
Dim vnt As Variant
Dim LastR As Long
Dim iRow As Long
Dim i As Long
vnt = Split(cCol, ",")
For i = 0 To UBound(vnt)
LastR = Cells(Rows.Count, vnt(i)).End(xlUp).Row
iRow = cFirstR
Do
If Cells(iRow, vnt(i)) <> "" And Cells(iRow + 1, vnt(i)) <> "" Then
If Cells(iRow, vnt(i)) <> Cells(iRow + 1, vnt(i)) Then
Cells(iRow + 1, vnt(i)).EntireRow.Insert xlShiftDown
'Cells(iRow + 1, vnt(i)).Interior.ColorIndex = i + 3
LastR = LastR + 1
End If
End If
iRow = iRow + 1
Loop Until iRow > LastR
Next
End Sub
Sub AddBlankRows()
Const cCol As Variant = "A"
Const cFirstR As Long = 1
Dim LastR As Long
Dim iRow As Long
LastR = Cells(Rows.Count, cCol).End(xlUp).Row
iRow = cFirstR
Do
If Cells(iRow, cCol) <> "" And Cells(iRow + 1, cCol) <> "" Then
If Cells(iRow, cCol) <> Cells(iRow + 1, cCol) Then
Cells(iRow + 1, cCol).EntireRow.Insert xlShiftDown
'Cells(iRow + 1, cCol).Interior.ColorIndex = 3
LastR = LastR + 1
End If
End If
iRow = iRow + 1
Loop Until iRow > LastR
End Sub
Je pense que vous avez juste besoin d'une boucle plus propre ... est-ce que cela fonctionne ...?
Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer, oRng As Range
Set oRng = Range("a1")
iRow = oRng.Row
iCol = oRng.Column
'Need to find last row....
Dim theEND As Long
theEND = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Do While Cells(iRow, iCol).Text <> "" Or iRow <= theEND
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
Loop
End Sub
Ceci est incroyable!! Fonctionne très bien :) J'apprécie vraiment l'aide.
Haha, compris! Merci encore!
Merci @PGCodeRider pour la prise! :)
J'ajouterais un compteur de lignes vides. Ensuite, vous pouvez définir un seuil maximum. J'ai également ajouté une condition de sortie de boucle infinie, juste parce que.
C'est ce que j'ai qui semble fonctionner. J'espère que cela vous aidera.
Option Explicit
Const c_intMaxBlanks As Integer = 5
Sub AddBlankRows()
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Dim intBlankCnt As Integer
Dim intMaxBlanks As Integer
Dim blnIsDone As Boolean
Dim intSaveStartRow As Integer
Dim blnStartCnt As Boolean
blnIsDone = False
Set oRng = Range("a1")
iRow = oRng.Row
iCol = oRng.Column
blnStartCnt = False
Do
'Check for blank Row using length of string
If (Len(Trim(Cells(iRow, iCol).Text)) > 0) Then
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
Else
iRow = iRow + 1
End If
'Check for blank Row using length of string
If (Len(Trim(Cells(iRow, iCol).Text)) < 1) Then 'Check for blank Row using length of string
If Not blnStartCnt Then
intSaveStartRow = iRow
blnStartCnt = True
Else
If (intSaveStartRow + intBlankCnt) <> iRow Then
'restart
intSaveStartRow = iRow
intBlankCnt = 0
End If
End If
intBlankCnt = intBlankCnt + 1
Else
'restart
blnStartCnt = False
intBlankCnt = 0
End If
If intBlankCnt >= c_intMaxBlanks Then blnIsDone = True
If iRow > 500 Then
MsgBox "Stopping Loop: Maybe Infinite"
Exit Do
End If
Loop While (Not blnIsDone)
End Sub
Pourquoi avez-vous des lignes vides dans vos données? Ce n'est pas une bonne conception des données. Fournissez une capture d'écran de la mise en page de vos données et expliquez ce à quoi vous vous attendez.
J'espère que ma modification l'a rendu plus clair!
J'ai mis à jour ma réponse avec la version complète.