[déplacé VB6 -> VBA] RANGE VALEURS

Signaler
Messages postés
3
Date d'inscription
dimanche 27 décembre 2009
Statut
Membre
Dernière intervention
27 décembre 2009
-
Messages postés
133
Date d'inscription
mardi 24 décembre 2002
Statut
Membre
Dernière intervention
8 juin 2012
-
Bonjour,
J'ai un problème avec VBA!
J'essaye de définir un range avec deux valeurs "01/2010" et "02/2010" et non position (A1, A2, etc):

Je cherche la cellule ayant ma valeur "TOTAL DEFINITE" mais cette cellule est présente plusieurs fois, une pour chaque mois et je dois définir d'abord le range par mois
Seulement, les valeurs "01/2010" et "02/2010" etc sont variables et ne sont pas dans des cellules fixes
ET JE N'ARRIVE PAS A DEFINIR UN RANGE AVEC DES VALEURS pour les mois

Sub cecile4()

For each cell in Range ' (PROBLEME: CELA DEVRAIT RESSEMBLER A RANGE.VALUE 01/2010 à RANGE.VALUE 02/2010)
If cell = ("TOTAL Definite") Then
cell.Select
ActiveCell.Offset(0, 6).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Jan 10").Select
Range("C24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next

For each cell in Range ' (PROBLEME: CELA DEVRAIT RESSEMBLER A RANGE.VALUE 02/2010 à RANGE.VALUE 03/2010)
If cell = ("TOTAL Definite") Then
cell.Select
ActiveCell.Offset(0, 6).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Fev 10").Select
Range("C24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next

(...)

End Sub

Merci beaucoup pour votre aide.

Cécile

5 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Salut
Ca n'a pas beaucoup de sens, tout ça.
Rappelle toi qu'on n'a pas ta feuille sous les yeux.
Range n'accepte comme paramètre que des choses qui ressemblent à des groupements de cellules, comme "A1", "A1:A2" ou "LeNomDuneZoneDeCellulesDéfiniParMoi"

Est-ce que ce que tu cherches à faire est de demander à Range de retrouver seul la cellule qui renferme le texte "01/2010" ?
Non, ce n'est pas possible.

Tu parles de Range avec des dates, mais la seule chose qui contient une date dans ton exemple, c'est le nom des feuilles.
On est un peu paumé, là.
Si tu dois parcourir toutes les feuilles de ton classeur, fait une simple boucle, genre :
  Dim maFeuille As Object
  For Each maFeuille In Sheets
    Debug.Print maFeuille.Name
  Next
(*) Au fait, merci d'utiliser la coloration syntaxique quand tu colles du code, sinon, l'indentation disparait et, sans couleur, c'est chiant (et décourageant) à lire.

Sinon, explique mieux ton problème, donne des exemples courts de ce que tu as sous les yeux ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
3
Date d'inscription
dimanche 27 décembre 2009
Statut
Membre
Dernière intervention
27 décembre 2009

Salut Jack!
Merci pour ta réponse et tes recommandations!

Ma question était bien
Est-ce que ce que tu cherches à faire est de demander à Range de retrouver seul la cellule qui renferme le texte "01/2010" ?
Non, ce n'est pas possible.

Et j'ai eu ma réponse, Merci.

La question des feuilles n'est pas un problème, ce n'est que du copy paste values.
En fait j'ai un rapport sur un sheet ainsi que 12 sheets par mois
Mon rapport ressemble à cela:

01/2010
...
Total Definite

02/2010
...
Total Definite

03/2010
...
Total Definite

04/2010
...
Total Definite

etc

Et mon problème est de copier une partie de la ligne "Total Definite" sur l'onglet des différents mois respectifs.
Par example, copier la ligne "Total Definite" située dans mon rapport entre "01/2010" et "02/2010" sur le sheet "Jan 10".

Seulement, j'ai un nouveau rapport chaque jour et parfois, certains mois ne sont pas présents. C'est pour cela que je désirais chercher la cellule "Total Definite" au sein du range par mois dans mon rapport.
et définir mon range par des valeurs...

J'espère avoir été assez claire.
Merci beaucoup de ton aide.

Cécile
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Oui, bah rechercher une cellule, c'est toujours possible, mais pas directement avec Range.
Tu peux utiliser un Find (enregistre une macro pendant que tu fais une recherche manuelle).
Si tes données sont dans la colonne A, tu peux aussi scruter chaque cellule du Range à la recherche du texte qu'il te faut :
- une boucle For Each Cell In Range("AA"), si c'est la colonne A
- un If sur la Value de Cell pour rechercher quelque chose qui ressemble (Like) à "XX/YYYY"
If Cell.Value Like "[0-9][0-9]/[0-9][0-9][0-9][0-9]" Then
- un récorticage pour récupérer le numéro du mois (Left) si besoin
- tu fais ensuite une nouvelle boucle For Each OtherCell In Range(???) où ??? est une variable qui représente le Range que tu définis entre l'adresse de Cell actuelle et A32700, exemple
For Each OtherCell In Range(Cell.Address & ":A32768")
  If OtherCell.Value = "Total Definite" Then
    ' ce que tu veux faire (ton copier/coller)
    Exit For ' ressort de la boucle
  End If
Next
- puis tu reprends la suite de la première boucle (Next)

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
3
Date d'inscription
dimanche 27 décembre 2009
Statut
Membre
Dernière intervention
27 décembre 2009

Re bonjour Jack,
MErci encore de ton aide mais je vais devoir la solliciter une nouvelle fois. Mes data se trouvant dans la colonne A pour les mois et total definite alors j'ai essayé tes codes mais cela ne marche pas. J'ai dû sûrement faire une erreur. Peux tu regarder?

Sub cecile()
Sheets("Def").Select
For Each cell In Range("A:A")
If cell.Value Like "[0-9][0-9]/[0-9][0-9][0-9][0-9]" Then
If Left(cell.Value, 2) = "01" Then
cell.Select
Exit For
End If
End If

For Each othercell In Range(cell.Address & ":A500")
    If othercell.Value = "TOTAL  Definite" Then
    cell.Select
    ActiveCell.Offset(0, 6).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Jan 10").Select
    Range("C24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Def").Select
Exit For
End If

Next
Next

Sheets("Def").Select
For Each cell In Range("a:a")
If cell.Value Like "[0-9][0-9]/[0-9][0-9][0-9][0-9]" Then
If Left(cell.Value, 2) = "02" Then
cell.Select
End If
End If
Exit For
Next
For Each othercell In Range(cell.Address & ":A500")
    If othercell.Value = "TOTAL  Definite" Then
    cell.Select
    ActiveCell.Offset(0, 6).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fev 10").Select
    Range("C24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Def").Select
End If
Exit For
Next
Sheets("Def").Select

End Sub

Merci beaucoup
Cecile
Messages postés
133
Date d'inscription
mardi 24 décembre 2002
Statut
Membre
Dernière intervention
8 juin 2012
4
Bonjour,

Essaye comme ça!
C'est encore simplifiable mais je te laisse t'en occuper!

Sub Cecile()
    Dim I As Long, J As Long, K As Long
    I = TrouveDate("01/2010")
    If I > 0 Then
        J = TrouveTotal(I)
        With Worksheets("Def").Range("A" & J + I)
            K = .Offset(0, 6).End(xlToRight).Column - 7
            Worksheets("Jan 10").Range(Worksheets("Jan 10").Range("C24"), _
                Worksheets("Jan 10").Range("C24").Offset(0, K)).Value _
                    = Worksheets("Def").Range(.Offset(0, 6), .Offset(0, 6 + K)).Value
        End With
    End If
    I = TrouveDate("02/2010")
    If I > 0 Then
        J = TrouveTotal(I)
        With Worksheets("Def").Range("A" & J + I)
            K = .Offset(0, 6).End(xlToRight).Column - 7
            Worksheets("Fev 10").Range(Worksheets("Fev 10").Range("C24"), _
                Worksheets("Fev 10").Range("C24").Offset(0, K)).Value _
                    = Worksheets("Def").Range(.Offset(0, 6), .Offset(0, 6 + K)).Value
        End With
    End If
End Sub

Function TrouveDate(laDate As String) As Long
    TrouveDate = Application.Evaluate("MATCH(""" & laDate & """,Def!A:A,0)")
End Function

Function TrouveTotal(Depart As Long) As Long
    TrouveTotal = Application.Evaluate("MATCH(""Total Definite"",Def!A" & _
        Depart & ":A" & Worksheets("Def").Rows.Count & ",0)") - 1
End Function


ctac