suite de la question de vendredi...

Le
Misange
dans le fil de vendredi 30/03/2007 19h45
VBA : boucler sur des cellules répondant à plusieurs critères

Je me permets de mettre ça ici, la ficelle de vendredi étant déjà un peu
rassie, pour attirer l'attention de VBAistes qui auraient envie de se
pencher sur mon petit (si petit !) problème de compilation ;-)
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #4313651
Bonsoir Misange,

Sub compile()
Application.DisplayAlerts = False
Sheets("temp").Delete
Sheets("transfert").Copy before:=Sheets(2)
ActiveSheet.Name = "temp"
Sheets("detfact").Select
For Each c In Range([B2], [B65000].End(xlUp))
If c = 0 Then
ligne = Sheets("temp").[A65000].End(xlUp).Row + 1
Sheets("temp").Cells(ligne, 1) = c.Offset(0, -1)
Sheets("temp").Cells(ligne, 15) = c
Sheets("temp").Cells(ligne, 23) = c.Offset(0, 2)
Sheets("temp").Cells(ligne, 24) = c.Offset(0, 3)
Sheets("temp").Cells(ligne, 25) = c.Offset(0, 4)
End If
Next c
Sheets("temp").Select
Range("A1:Z10000").Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess
End Sub

http://cjoint.com/?ectM6OYymx

JB


On 2 avr, 19:22, Misange
... dans le fil de vendredi 30/03/2007 19h45
VBA : boucler sur des cellules répondant à plusieurs critères

Je me permets de mettre ça ici, la ficelle de vendredi étant déjà un peu
rassie, pour attirer l'attention de VBAistes qui auraient envie de se
pencher sur mon petit (si petit !) problème de compilation ;-)
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !http://xlwiki. free.fr/wikihttp://www.excelabo.net


JB
Le #4313561
http://cjoint.com/?ecuyaUnxqd

JB

On 2 avr, 19:22, Misange
... dans le fil de vendredi 30/03/2007 19h45
VBA : boucler sur des cellules répondant à plusieurs critères

Je me permets de mettre ça ici, la ficelle de vendredi étant déjà un peu
rassie, pour attirer l'attention de VBAistes qui auraient envie de se
pencher sur mon petit (si petit !) problème de compilation ;-)
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !http://xlwiki. free.fr/wikihttp://www.excelabo.net


MichDenis
Le #4313521
Si ta plage est substantielle, il y a la possibilité d'utiliser le filtre automatique !


'----------------------------------
Sub Test()

Dim Rg As Range, Adr As String, Dest As Range, V As String
Dim A As Long

'Déterminer la plage à scanner
With Worksheets("Feuil1")
Set Rg = .Range("A1:C" & .Range("A65536").End(xlUp).Row)
End With

'Où copier les données
Set Dest = Worksheets("feuil2").Range("A1")

On Error Resume Next
' à déterminer la valeur à trouver
V = Application.InputBox(Prompt:="Chaîne à trouver?", Type:=2)
If V = "" Then Exit Sub
If Format(V) = False Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
With Rg
Set T = .Find(V, LookIn:=xlValues)
If Not T Is Nothing Then
Adr = T.Address
Do
If T.Offset(, 1) <> "" Then
If T.Offset(, 1) = 0 Then
A = A + 1
Dest(A).Resize(, 3).Value = T.Resize(, 3).Value
End If
End If
Set T = .FindNext(T)
Loop While Not T Is Nothing And T.Address <> Adr
End If
End With
Application.EnableEvents = True
End Sub
'----------------------------------




"Misange"
... dans le fil de vendredi 30/03/2007 19h45
VBA : boucler sur des cellules répondant à plusieurs critères

Je me permets de mettre ça ici, la ficelle de vendredi étant déjà un peu
rassie, pour attirer l'attention de VBAistes qui auraient envie de se
pencher sur mon petit (si petit !) problème de compilation ;-)
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Misange
Le #4313471
Merci Denis
c'est effectivement une variation intéressante. La soluce de JB me
parait plus simple mais celle-ci peut trouver d'autres applications, je
garde :-)
Merci à vous deux

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Si ta plage est substantielle, il y a la possibilité d'utiliser le filtre automatique !


'----------------------------------
Sub Test()

Dim Rg As Range, Adr As String, Dest As Range, V As String
Dim A As Long

'Déterminer la plage à scanner
With Worksheets("Feuil1")
Set Rg = .Range("A1:C" & .Range("A65536").End(xlUp).Row)
End With

'Où copier les données
Set Dest = Worksheets("feuil2").Range("A1")

On Error Resume Next
' à déterminer la valeur à trouver
V = Application.InputBox(Prompt:="Chaîne à trouver?", Type:=2)
If V = "" Then Exit Sub
If Format(V) = False Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
With Rg
Set T = .Find(V, LookIn:=xlValues)
If Not T Is Nothing Then
Adr = T.Address
Do
If T.Offset(, 1) <> "" Then
If T.Offset(, 1) = 0 Then
A = A + 1
Dest(A).Resize(, 3).Value = T.Resize(, 3).Value
End If
End If
Set T = .FindNext(T)
Loop While Not T Is Nothing And T.Address <> Adr
End If
End With
Application.EnableEvents = True
End Sub
'----------------------------------




"Misange"
... dans le fil de vendredi 30/03/2007 19h45
VBA : boucler sur des cellules répondant à plusieurs critères

Je me permets de mettre ça ici, la ficelle de vendredi étant déjà un peu
rassie, pour attirer l'attention de VBAistes qui auraient envie de se
pencher sur mon petit (si petit !) problème de compilation ;-)


MichDenis
Le #4313401
| La soluce de JB me parait plus simple

| For Each c In Range([B2], [B65000].End(xlUp))
| If c = 0 Then

Pour la soluce de JB, tu devras ajouter un autre test si
tu as "C = "" , car tu risques de te retrouver avec des lignes
indésirées dans les cas où tu as des cellules vides en colonne b:b
Misange
Le #4313331
effectivement mais ce n'est pas le cas, il y a toujours un nombre
(différent) ou 0

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

| La soluce de JB me parait plus simple

| For Each c In Range([B2], [B65000].End(xlUp))
| If c = 0 Then

Pour la soluce de JB, tu devras ajouter un autre test si
tu as "C = "" , car tu risques de te retrouver avec des lignes
indésirées dans les cas où tu as des cellules vides en colonne b:b




Publicité
Poster une réponse
Anonyme