Discussion :

[gaby12]

Bonjour à tous;

Il faudrait inscrire dans une cellule d'une page resultat les valeurs du tableau de la feuil1 qui sont dans les cellules jaunes en éliminant les doulons

sachant que dans d'autres exemples, il peut avoir des valeurs non négatives à la place des zéro

VBA ou pas VBA

Merci d'avance

@+

Gaby12

[Kimy_Ire]

Bonjour gaby12,

En utilisant la fonction "FindAll" du net et deux petits enregistreurs de macro, voici ce que je te propose (sur le fichier exemple) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Option Explicit
 
Sub gaby12()
Dim oRng As Range
Dim oCell As Range
Dim k As Integer
 
With Worksheets("Feuil1")
    Application.FindFormat.Clear
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Set oRng = FindAll("*", .UsedRange, xlFormulas, xlPart, SearchFormat:=True)
    k = 0
    With Worksheets("Feuil3")
        .Columns(1).Clear
        For Each oCell In oRng
            'MsgBox oCell.Address
            .Range("A1").Offset(k, 0) = oCell
            k = k + 1
        Next oCell
        .Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo
    End With
End With
 
End Sub
 
Function FindAll(What, Optional SearchWhat As Variant, _
        Optional LookIn, _
        Optional LookAt, _
        Optional SearchOrder, _
        Optional SearchDirection As XlSearchDirection = xlNext, _
        Optional MatchCase As Boolean = False, _
        Optional MatchByte, _
        Optional SearchFormat) As Range
    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings _
     for the Application.FindFormat object, e.g., _
     Application.FindFormat.NumberFormat = "General;-General;""-"""
    Dim aRng As Range
    If IsMissing(SearchWhat) Then
        On Error Resume Next
        Set aRng = ActiveSheet.UsedRange
        On Error GoTo 0
    ElseIf TypeOf SearchWhat Is Range Then
        If SearchWhat.Cells.Count = 1 Then
            Set aRng = SearchWhat.Parent.UsedRange
        Else
            Set aRng = SearchWhat
            End If
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set aRng = SearchWhat.UsedRange
    Else
        Exit Function                       '*****
        End If
    If aRng Is Nothing Then Exit Function   '*****
    Dim FirstCell As Range, CurrCell As Range
    With aRng.Areas(aRng.Areas.Count)
    Set FirstCell = .Cells(.Cells.Count)
        'This little 'dance' ensures we get the first matching _
         cell in the range first
        End With
    Set FirstCell = aRng.Find(What:=What, After:=FirstCell, _
        LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
        MatchByte:=MatchByte, SearchFormat:=SearchFormat)
    If FirstCell Is Nothing Then Exit Function          '*****
    Set CurrCell = FirstCell
    Set FindAll = CurrCell
    Do
        Set FindAll = Application.Union(FindAll, CurrCell)
        'Setting FindAll at the top of the loop ensures _
         the result is arranged in the same sequence as _
         the  matching cells; the duplicate assignment of _
         the first matching cell to FindAll being a small _
         price to pay for the ordered result
        Set CurrCell = aRng.Find(What:=What, After:=CurrCell, _
            LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
            MatchByte:=MatchByte, SearchFormat:=SearchFormat)
        'FindNext is not reliable because it ignores the FindFormat settings
    Loop Until CurrCell.Address = FirstCell.Address
End Function

N'hésite pas à revenir vers moi !
Cordialement,
Kimy

[Menhir]

Il n'est pas possible de récupérer la couleur de fond d'une cellule avec de simples fonctions Excel. Il faut forcément développer du code VBA.
Je me suis déjà cogné au problème.
J'avais écris la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Function Coul(YYY1 As Range) As Long
   Application.Volatile
   Coul = YYY1.Interior.ColorIndex
End Function

Mais à cause de l'option Volatile, elle alourdit considérablement une feuille quand elle est utilisée en grand nombre.

Qu'est-ce que tu appelles "inscrire les valeurs d'un tableau" ? Une concaténation ? Une somme ?

[gaby12]

Merci beaucoup pour cette reponse aussi rapide

Dans l'exemple , j'ai teinté juste pour montrer les valeurs que je veux extraire

les cellules qui m'interessent sont non-nulles et dans une colonne sur deux et aussi ne pas mettre deux fois la même valeur ... comme montré sur la page resultat

Cordialement

@+

Gaby12

[Kimy_Ire]

Comment ne pas être explicite dans ses énoncés...

[Menhir]

les cellules qui m'interessent sont non-nulles et dans une colonne sur deux et aussi ne pas mettre deux fois la même valeur ... comme montré sur la page resultat

Tu comptes distiller tes prescriptions au compte-goutte où tu comptes décrire précisément ton problème en une fois ?

Petit rappel aussi : http://www.developpez.net/forums/d84...s-discussions/

[gaby12]

L'onglet Feuil1 est un tableau simplifié - en réalité toutes les cellules contiennent des formules -
j'ai teinté les cellules juste pour mettre en evidence les cellules (oublions la couleur) --je l'ai même supprimé.

ce tableau sert à determiner de valeurs de vitesse d'apres la valeur de la cellule adjacente (si la valeur de la cellule adjacente est inferieure à 0.0005 j'ai fait inscrire "0" mais je pourrais mettre cellule vide si besoin)

le premier onglet "resultat" est la simplification d'un rapport de tests dont une cellule indiquera les vitesses critiques que la feuil1 a mis en evidence

je voudrais ce resultat pas concaténation avec des virgules comme séparation

on peut opter pour une cellule par valeur ( pas de doublons).

Cordialement

@+

Gaby12

[(WOLF)]

Bonjour, par rapport à l'ancien fichier, cette macro est une première approche.
J'ai supposé que Y est toujours inferieur à 1 donc si ce n'est pas le cas, il faudra essayer autrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    Dim cellule As Range
    Dim dc As Long
    dc = Sheets("feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
    Sheets("feuil1").Range(Cells(2, 2), Cells(5, dc)).Select
    For Each cellule In Selection
        If IsNumeric(cellule) And cellule > 1 Then
            If Sheets("feuil1").Range("a8").Find(cellule, lookat:=xlPart) Is Nothing Then
                Sheets("feuil1").Range("a8") = Sheets("feuil1").Range("a8") & cellule & ";"
            End If
        End If
    Next
End Sub

Il faut changer la destination du résultat qui pour les tests sont affiché en cellule A8 (ligne en couleur orange)

[gaby12]

Merci WOLF

C'est impeccable

Encore merci beaucoup

Cordialement

Gaby12

[(WOLF)]

et puis il faudra changer celle là aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Sheets("feuil1").Range("a8").Find(cellule, lookat:=xlPart)

J'avais la tête ailleurs pardonnez moi

[gaby12]

Merci beaucoup
J'avais rectifié de moi-même

J'ai adapté la macro a mon document definitif et ça fonctionne

Est-ce possible de mettre une valeur par cellule ?

Cordialement

Gaby

[(WOLF)]

Oui, c'est possible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
    Dim cellule As Range
    Dim dc As Long
    Sheets("resultat").Range("a:a").ClearContents
    dc = Sheets("feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
    Sheets("feuil1").Range(Cells(2, 2), Cells(5, dc)).Select
    For Each cellule In Selection
        If IsNumeric(cellule) And cellule > 1 Then
            If Sheets("Resultat").Range("a1").Find(cellule, lookat:=xlPart) Is Nothing Then
                Sheets("resultat").Range("a1") = Sheets("resultat").Range("a1") & cellule & ";"
                Sheets("Resultat").Range("a" & Sheets("Resultat").Range("a" & Rows.Count).End(xlUp).Row).Offset(1, 0) = cellule
            End If
        End If
    Next
    Sheets("resultat").Range("A1") = "Vitesse"
    Sheets("resultat").Activate
End Sub

Mieux encore :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub test()
    Dim cellule As Range
    Dim dc As Long
    Dim dl As Long
    Sheets("resultat").Range("a:a").ClearContents
    dc = Sheets("feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
       dl = Sheets("feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("feuil1").Range(Cells(2, 2), Cells(dl, dc)).Select
    For Each cellule In Selection
        If IsNumeric(cellule) And cellule > 1 Then
            If Sheets("Resultat").Range("a1").Find(cellule, lookat:=xlPart) Is Nothing Then
                Sheets("resultat").Range("a1") = Sheets("resultat").Range("a1") & cellule & ";"
                Sheets("Resultat").Range("a" & Sheets("Resultat").Range("a" & Rows.Count).End(xlUp).Row).Offset(1, 0) = cellule
            End If
        End If
    Next
    Sheets("resultat").Range("A1") = "Vitesse"
    Sheets("resultat").Activate
End Sub

J'ai rajouté la prise en compte du nombre de ligne donc en colonne A vous pouvez rajouter d'autres vitesses

[gaby12]

merci beaucoup WOLF

Bonjour

J'ai du arrêter de travailler là-dessus.
Alors je n'ai pas remercié dans la foulée et je vous demande de bien m'excuser
J’espérai toujours reprendre le lendemain.

Il me reste juste une chose à faire:
- limiter le nombre de résultat ou qu'il en ait assez.

J'ai pensé qu'au lieu d'indiquer dans les formules : mettre vitesse 0 si la cellule à coté est inférieure à 0.0005 (Feuil1) , il faudrait donner une valeur suffisamment petite et augmenter d'une certaine valeur jusqu’à qu'il n'y ait que 4 valeurs ( page résultat)par exemple et ensuite lancer les macros excitantes

Merci d'avance

Bon weekend

Cordialement

Gaby