[déplacé VB6 - VBA] RANGE VALEURS

Question

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

cs_Jack · Answer

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)

cs_joyeuxnoel · Answer

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

cs_Jack · Answer

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)

cs_joyeuxnoel · Answer

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

CTAC · Answer

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

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

5 réponses

Votre réponse

Discussions similaires