Recherche valeur sur plusieurs lignes d'une même cellule

[sellig 29]

Bonjour,

Je souhaiterais extraire des données, sous condition, de cellules renseignées sur plusieurs lignes Les explications dans le fichier joint sont plus claires! En espérant que ma demande est réalisable, merci d'avance pour votre aide.

 

[vmatthieu]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

bonsoir,
je ne sais pas si j'ai bien compris mais voilà un premier essai
bonne soirée

 

[sellig 29]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonjour vmatthieu
J'ai malheureusement un message d'erreur "expression trop complexe" et le code apparaît en jaune dans la macro " For ligne = 4 To Range("a" & Rows.Count).End(xlUp).Row"

 

[Compte Supprimé 979]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonjour le fil

Le code de vmatthieu fonctionne chez moi, en revanche il ne prend pas en compte le mois !?
(Il n'effectue la recherche que sur le jour)

A+

 

[sellig 29]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonjour à tous,

Je l'ai testé sur 2 PC différents, le message d'erreur apparaît dans les 2 cas ? De plus, si le mois n'est pas intégré dans la recherche (comme le dit BrunoM45) le résultat attendu ne pourra pas être exact!

 

[Compte Supprimé 979]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Re,

J'ai trouvé le code qui devrait aller pas trop mal, sauf pour le premier mois (décembre)

Sub Extraction()
  Dim DLig As Long, Lig As Long, Col As Integer
  Dim ShtD As Worksheet, sTab() As String
  Dim iJour As Integer, iMois As Integer
  ' Définir la feuille de Destination
  Set ShtD = Sheets("Feuil2")
  ' Effacer les valeurs de la colonne A
  ShtD.Range("A18:A" & Rows.Count).ClearContents
  ' Récupérer le jour et le mois de la date
  iJour = Day(ShtD.Range("E17").Value)
  iMois = Month(ShtD.Range("E17").Value)
  ' Avec la feuille de données
  With Sheets("Feuil1")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne de la feuille données
    For Lig = 4 To DLig
      ' Pour les colonnes de X à BH
      For Col = .Range("X4").Column To .Range("BH4").Column
        ' Remplir un tableau des valeurs de la cellules
        sTab = Split(.Cells(Lig, Col).Value, Chr(10))
        ' Si la dimension du tableau est >= à celle du mois
        If UBound(sTab) >= iMois Then
          ' Vérifier si existe une valeur pour le mois concerné
          If sTab(iMois) <> "--" And sTab(iMois) <> "" Then
            ' Vérifier si existe la journée concernée
            If CInt(sTab(iMois)) = iJour Then
              ' Inscrire le numéro
              If ShtD.Range("A18").Value = "" Then
                ShtD.Range("A18").Value = .Range("A" & Lig).Value
              Else
                ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = .Range("A" & Lig).Value
              End If
            End If
          End If
        End If
      Next Col
    Next Lig
  End With
End Sub

A+

 

[sellig 29]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Merci BrunoM45, c'est super, j'ai testé, ça fonctionne impeccable .
Pour le mois de décembre qui apparaît 2 fois sous la même dénomination, je suppose que cela pose un problème d'identification? (l'extraction des données va du milieu de décembre 2012 à milieu de décembre 2013 ) Si l'extraction de données courrait uniquement sur 12 mois (arrêtée au 30 novembre donc pas de doublon du mois de décembre), la 1ère ligne serait elle dans ce cas prise en compte?

 

[job75]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonjour à tous,

Une autre solution (mais proche de celle de Bruno) dans la fichier joint :

Sub Recherche()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim txt$, lig&, smois, i&, j%, s, k%
txt = Application.Proper(Left(Format([E17], "dddd"), 2)) & Day([E17]) & Format([E17], "mmmm")
lig = 18 '1ère ligne des résultats
With Feuil1
  smois = Split(.Cells(4, 23).Text, vbLf)
  For i = 4 To .[A65536].End(xlUp).Row
    For j = 24 To 60
      s = Split(.Cells(i, j), vbLf)
      For k = 0 To UBound(s)
        If Val(s(k)) Then
          If .Cells(3, j) & Val(s(k)) & smois(k) = txt Then
            Feuil2.Cells(lig, 1) = .Cells(i, 1)
            lig = lig + 1
          End If
        End If
      Next
    Next
  Next
End With
End Sub

On compare le nombre et le mois mais on vérifie aussi les 2 premières lettres du jour.

A+

 

[sellig 29]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Merci Job75 c'est super! Votre code présente l'avantage, par rapport à celui de BrunoM45, c'est d'intégrer les 2 mois de décembre.
Il n'efface toutefois pas les données précédentes et ne convertit pas les valeurs texte en numérique mais cela n'est qu'un détail, peut être arriverai je à l'adapter en mixant avec celui de Bruno?
Cordialement

 

[job75]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Re,

Pas bien difficile :

1) pour effacer les données (excédentaires) précédentes, terminer par :

Feuil2.Range("A" & lig & ":A" & Rows.Count).ClearContents

2) pour transformer les résultats textes en nombres, ajouter .Value :

Feuil2.Cells(lig, 1) = .Cells(i, 1).Value

La macro modifiée :

Sub Recherche()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim txt$, lig&, smois, i&, j%, s, k%
txt = Application.Proper(Left(Format([E17], "dddd"), 2)) & Day([E17]) & Format([E17], "mmmm")
lig = 18 '1ère ligne des résultats
With Feuil1
  smois = Split(.Cells(4, 23).Text, vbLf)
  For i = 4 To .[A65536].End(xlUp).Row
    For j = 24 To 60
      s = Split(.Cells(i, j), vbLf)
      For k = 0 To UBound(s)
        If Val(s(k)) Then
          If .Cells(3, j) & Val(s(k)) & smois(k) = txt Then
            Feuil2.Cells(lig, 1) = .Cells(i, 1).Value
            lig = lig + 1
          End If
        End If
      Next
    Next
  Next
End With
Feuil2.Range("A" & lig & ":A" & Rows.Count).ClearContents
End Sub

Fichier (2).

A+

 

[vmatthieu]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

bonsoir à tous,
job75 , permets moi une question (tu n"es pas obligé d'y répondre mais j'apprécierais grandement )
pourquoi certaines de tes variables lors de tes déclarations sont suivies de $ ou & ou %
bon sinon y a plein d'autres chose que je ne comprends pas dans ton code mais je ne vais pas abuser...
bonne soirée

 

[job75]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonsoit vmatthieu,

On peut utiliser des caractères pour déclarer les variables, c'est plus bref :

$ => As String

% => As Integer

& => As Long

! => As Single

# => As Double.

Bonne nuit et A+

 

[vmatthieu]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

c'est plus bref,c'est plus bref ...
pour moi le temps que je me souvienne, que je me trompe, que je corrige et en fin de compte je revienne à écrire "as string"; ce n'est pas plus bref
merci de ta réponse, j'ai donc une question sans réponse de moins.
bonne soirée

 

[sellig 29]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Merci Job75, c'est génial , comme à votre habitude vous arrivez à résoudre efficacement toutes les demandes parfois un peu tordues des excelnautes... Toutes mes félicitations!
Merci également à Mathieu et Bruno, bon weekend à vous tous! Ca semble parti sous la pluie pour le Finistère, mais bon, pour une fois....

 

[job75]

Re : Recherche valeur sur plusieurs lignes d'une même cellule

Bonjour sellig 29, le forum,

Il est mieux de mettre le code dans une macro Worksheet_Change :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E17]) Is Nothing Then Exit Sub
Dim lig&, txt$, smois, i&, j%, s, k%
lig = 18 '1ère ligne des résultats
If IsDate([E17]) Then
  txt = Application.Proper(Left(Format([E17], "dddd"), 2)) & Format([E17], "dmmmm")
  With Feuil1 'CodeName de la feuille
    smois = Split(.[W4], vbLf)
    For i = 4 To .[A65536].End(xlUp).Row
      For j = 24 To 60
        s = Split(.Cells(i, j), vbLf)
        For k = 0 To UBound(s)
          If Val(s(k)) Then
            If .Cells(3, j) & Val(s(k)) & smois(k) = txt Then
              Cells(lig, 1) = .Cells(i, 1).Value
              lig = lig + 1
            End If
          End If
        Next
      Next
    Next
  End With
End If
Range("A" & lig & ":A" & Rows.Count).ClearContents
End Sub

Fichier (3).

A+