Astuces Excel
  1. Astuces Excel
  3. Excel problèmes de boucle macro FindNext
Intereting Posts
La cellule contient une string dans une autre feuille de calcul Retourne Vrai Exception lorsque les files xls ouverts WebClient ne peut pas download un file généré à la volée de l'écriture à la réponse VBA: Copiez le contenu de la table de PowerPoint vers Excel 2016 Excel VBA: basculer les lignes masquer / afficher lorsque l'image a cliqué Excel à DataGrid Exponential Issue nExtend ne fonctionne pas avec une option si Déclaration Comment extraire datatables du site Web et stocker dans la feuille excel en c #? formule pour replace toutes les lignes contenant # ou nombres ou point virgule Interagir avec Excel en utilisant pywin32 Voulez-vous créer des feuilles de calcul dans Excel automatiquement Excel moyen avec date et supérieur aux critères Excel – Recherchez la feuille 1 en utilisant une list de Sheet 2 Appliquer le remplissage automatique pour plus de 1 RUP autrement ne s'applique pas Événement graphique – Les valeurs ne sont pas récupérées par code pour plus d'une série de données

Excel problèmes de boucle macro FindNext

Aidez-moi! .. Quand je cherche mCell, il suffit de courir avec la première valeur et ne pas boucle pour d'autres valeurs, alors qu'est-ce que je peux faire? 

Sub finddataver2() Dim mRange As Range Dim mFCell As Ssortingng Dim mCell As Range Dim mName As Ssortingng Dim sRange As Range Dim sFCell As Ssortingng Dim sCell As Range Dim seg As Ssortingng Dim neg As Ssortingng Dim i As Integer Dim finalrow As Integer neg = Sheets("FindSupp").Range("C2").Value mName = Sheets("FindSupp").Range("C4").Value seg = Sheets("FindSupp").Range("C6").Value Sheets("FindSupp").Range("B14:L2000").ClearContents Worksheets("Data").Select finalrow = Sheets("Data").Range("A10000").End(xlUp).row Worksheets("Data").Select Set mRange = Sheets("Data").Range("I:I") Set mCell = mRange.Find(What:=mName, MatchCase:=False, LookAt:=xlPart) Worksheets("Data").Select Set sRange = Sheets("Data").Range("H:H") Set sCell = sRange.Find(What:=seg, MatchCase:=False, LookAt:=xlPart) Worksheets("Data").Select For i = 2 To finalrow If neg = "All" Or neg = "" Then

Les problèmes commencent ici quand je suis sérieux pour la valeur qu'il ne boucle pas seulement pour la première valeur seulement de mCell 

  If mName = "" Or mName = "All" Then If seg = "" Or seg = "All" Then Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, ).PasteSpecial xlPasteFormulasAndNumberFormats ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then sFCell = sCell.Address Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Set sCell = sRange.FindNext(sCell) End If ElseIf Sheets("Data").Cells(i, 9) = mCell.Value Then If seg = "" Or seg = "All" Then Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then sFCell = sCell.Address Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Set sCell = sRange.FindNext(sCell) End If End If ElseIf Sheets("Data").Cells(i, 2) = neg Then If mName = "" Or mName = "All" Then If seg = "" Or seg = "All" Then Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then sFCell = sCell.Address Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Set sCell = sRange.FindNext(sCell) End If ElseIf Sheets("Data").Cells(i, 9) = mCell.Value Then If seg = "" Or seg = "All" Then Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Set mCell = mRange.FindNext(mCell) ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then sFCell = sCell.Address Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats End If End If End If Next i Worksheets("FindSupp").Select Cells(2, 3).Select Worksheets("FindSupp").Range("Z:Z").ClearContents End Sub

Pour rendre la question plus simple, comment puis-je faire bouger cette chose … 

  ElseIf Sheets("Data").Cells(i, 9) = mFCell Then If seg = "" Or seg = "All" Then Range(Cells(i, 1), Cells(i, 11)).Copy Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Set mCell = mRange.FindNext(mCell)

En fait, j'ai trouvé les problèmes où il se trouvait, mais les problèmes sont que je ne sais pas comment faire de la boucle 

  Worksheets("Data").Select Set mRange = Sheets("Data").Range("I:I") Set mCell = mRange.Find(What:=mName, MatchCase:=False, LookAt:=xlPart) Worksheets("Data").Select Set sRange = Sheets("Data").Range("H:H") Set sCell = sRange.Find(What:=seg, MatchCase:=False, LookAt:=xlPart)

Je pense que vous attaquez votre problème de manière plutôt gênante. Il y a des erreurs dans votre code (trop nombreuses pour listr si je suis brutalement honnête), mais j'aimerais vous proposer une structure de search différente.

Si j'ai correctement lu votre publication, vous souhaitez récupérer des lignes de données lorsque trois conditions sont remplies (neg, seg et m). Ces conditions sont vraies si l'user a sélectionné 'Tout' ou l'élément de search correspond à son élément de données respectif.

Pour ce faire, il vous suffit de stocker les flags de sauts si 'All' est sélectionné et ensuite passer à la ligne suivante si l'une des autres conditions est fausse.

Le code ci-dessous vous montre un moyen de le faire. Quelques points à noter:

  1. Lisez le grand set de données dans un tableau, car il est beaucoup plus rapide de manipuler.
  2. J'ai créé une structure de Type peu pour garder le code plus propre. Ce n'est vraiment qu'un détenteur d'un groupe de variables apparentées. Vous le définissez simplement en haut de votre module (au-dessus des Subs ou Functions ).
  3. Il n'est pas nécessaire de copyr / coller par rangée. Si vous devez coller (plutôt que d'écrire un tableau directement sur la feuille de travail de sortie), il est plus rapide de définir la plage cible et de copyr / coller tout en un seul coup.
  4. Votre PasteType xlPasteFormulasAndNumberFormats semble étrange – assurez-vous de savoir exactement ce que vous faites.
  5. Vous verrez à partir du code qu'il y a très peu besoin de Select feuilles ou des cellules dans VBA.

Voici le code – vous pouvez coller le lot entier dans un Module : 

 Option Explicit Private Type SearchItems Value As Ssortingng Skip As Boolean Index As Integer End Type Public Sub FindData() Dim item(2) As SearchItems Dim suppWs As Worksheet Dim dataWs As Worksheet Dim found As Boolean Dim data As Variant Dim hits As Range Dim r As Long Dim i As Integer 'Find the boundaries of your data however you wish 'I'm using a quick, but dirty, UsedRange object. 'Read data into an array Set dataWs = ThisWorkbook.Worksheets("Data") data = dataWs.UsedRange.Value2 'Set search item parameters Set suppWs = ThisWorkbook.Worksheets("FindSupp") With item(0) .Index = 2 .Value = suppWs.Range("C2").Value2 .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL") End With With item(1) .Index = 9 .Value = suppWs.Range("C4").Value2 .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL") End With With item(2) .Index = 8 .Value = suppWs.Range("C6").Value2 .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL") End With 'Loop through the data to find the compound matches For r = 2 To UBound(data, 1) found = True For i = 0 To 2 With item(i) If Not .Skip Then found = (data(r, .Index) = .Value) End With If Not found Then Exit For Next 'Add the row to our range if all conditions are met If found Then Set hits = SafeUnion(hits, dataWs.Cells(r, 1).Resize(, 11)) Next 'Do whatever you like with the found rows 'Your PasteSpecial PasteType is unusual but I've kept it here If Not hits Is Nothing Then hits.Copy suppWs.Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats End If End Sub Private Function SafeUnion(rng1 As Range, rng2 As Range) As Range If rng1 Is Nothing Then Set SafeUnion = rng2 Else Set SafeUnion = Union(rng1, rng2) End If End Function

Mettre à jour

Utilisez cette ligne si vous devez vérifier si la valeur est contenue dans la cellule: 

  If Not .Skip Then found = (InStr(data(r, .Index), .Value) > 0)