XL 2016 Récupérer les données de nom et de date VBA

Dadi147 · 16 Janvier 2023

Bonjour à tous. J'ai déjà été aidé @job75 Mais je dois modifier en raison de la nouvelle conception du fichier
La conception du fichier a été modifiée, je dois donc modifier le code pour extraire la date et le nom de la colonne i
Avec la même condition et la même méthode, existe-t-il un moyen de faire en sorte que le code s'exécute à partir de la première table vide et d'ignorer les tables qui ont été remplies auparavant car il s'exécute lentement lorsqu'il récupère les données

VB:

Sub Remplir_tout()
Dim nmax&, a$(), derlig&, tablo, i&, n&, c As Range, dat$, h&
With Sheets("Sheet1")
    '---liste des adresses---
    nmax = Application.CountIf(.[E:E], "Restaurant*") 'changé en colonne ("i")
    ReDim a(nmax) 'base 0
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row + 1 'changé en colonne ("K")
    a(nmax) = "E" & derlig 'dernier élément   changé en colonne (i")
    tablo = .Range("E1:F" & derlig) 'matrice, plus rapide, au moins 2 éléments  changé en colonne ("i")
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "E" & i: n = n + 1
    Next i
    '---remplissage des colonnes A et B
    Application.ScreenUpdating = False
    .[A:B].ClearContents 'RAZ
    .[A:B].HorizontalAlignment = xlCenter 'centrage
    For n = 0 To UBound(a) - 1
        Set c = .Range(a(n))
        dat = Mid(Trim(c(7, 0)), 11, 10)
        h = .Range(a(n + 1)).Row - 1 - c(5).Row
        If h > 0 Then
            If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
            c(6, -2).Resize(h) = c(2)
        End If
    Next n
End With
End Sub

Dadi147 · 17 Janvier 2023

sylvanu à dit:
Bonsoir Dadi, Oneida,
Un essai en PJ avec ce que j'ai compris:
1- On repère Restaurant xxx en colonne I, on extrait le nom du resto, la date et la Ref en dessous.
2- Tant qu'un nouveau resto n'est pas apparu alors on met en colonne A la date et en B la Ref.
3- Je ne remplis A et B que lorsque C est non vide.

VB:

Sub CompleteFeuille() Dim DL%, L%, L2% DL = [C65500].End(xlUp).Row Range("A1:B" & DL).ClearContents tablo = Range("A1:I" & DL + 2) For L = 1 To UBound(tablo) If tablo(L, 9) Like "Restaurant*" Then Resto = Mid(tablo(L, 9), 12) LaDate = Right(tablo(L + 2, 9), 10) For L2 = L + 4 To UBound(tablo) - 2 If tablo(L2 - 1, 3) Like "(4) Service fees =*" = True Then Exit For If tablo(L2, 3) <> "" Or tablo(L2 + 1, 3) Like "(4) Service fees =*" = True Then tablo(L2, 1) = LaDate tablo(L2, 2) = Resto End If Next L2 End If Next L [A1].Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo End Sub

Merci, mais il y a une légère différence, c'était indiqué sur l'image, avec la valeur répétée sans interruption dans la colonne du nom et de la date jusqu'à la fin de la première condition.

sylvanu · 17 Janvier 2023

Re,
Voir PJ.

Dadi147 · 17 Janvier 2023

sylvanu à dit:
Re,
Voir PJ.

Le résultat est différent de la photo

sylvanu · 17 Janvier 2023

Peut être pourrait on arrêter de jouer aux devinettes !

Dadi147 à dit:
Le résultat est différent de la photo

Car franchement ça, ça veut dire : "T'es nul, cherches un peu !"

On peut toujours donner quelques mots d'explications, ça ne coûte rien.
Un essai en PJ.

Dadi147 · 17 Janvier 2023

sylvanu à dit:
Peut être pourrait on arrêter de jouer aux devinettes !

Car franchement ça, ça veut dire : "T'es nul, cherches un peu !"
On peut toujours donner quelques mots d'explications, ça ne coûte rien.
Un essai en PJ.

Très cool. C'est ce qui est requis. Désolé, désolé pour le dérangement. Toujours

sylvanu · 17 Janvier 2023

La prochaine fois, soyez plus précis dans vos demandes. Ca évite à tout le monde de perdre du temps.
Bonne soirée.

Oneida · 18 Janvier 2023

sylvanu à dit:
Bonsoir Dadi, Oneida,
Un essai en PJ avec ce que j'ai compris:
1- On repère Restaurant xxx en colonne I, on extrait le nom du resto, la date et la Ref en dessous.
2- Tant qu'un nouveau resto n'est pas apparu alors on met en colonne A la date et en B la Ref.
3- Je ne remplis A et B que lorsque C est non vide.

VB:

Sub CompleteFeuille() Dim DL%, L%, L2% DL = [C65500].End(xlUp).Row Range("A1:B" & DL).ClearContents tablo = Range("A1:I" & DL + 2) For L = 1 To UBound(tablo) If tablo(L, 9) Like "Restaurant*" Then Resto = Mid(tablo(L, 9), 12) LaDate = Right(tablo(L + 2, 9), 10) For L2 = L + 4 To UBound(tablo) - 2 If tablo(L2 - 1, 3) Like "(4) Service fees =*" = True Then Exit For If tablo(L2, 3) <> "" Or tablo(L2 + 1, 3) Like "(4) Service fees =*" = True Then tablo(L2, 1) = LaDate tablo(L2, 2) = Resto End If Next L2 End If Next L [A1].Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo End Sub

Bonjour,
Votre code est surement Ok, mais comment avez vous fait pour verifier, y pas de donnees en colonne I, donc A:B rien. Je aurai pu faire un copier/coller de la colonne E en I mais, je prefere que ce soit le demandeur qui le fasse, ca evite les soucis.

Oneida · 18 Janvier 2023

sylvanu à dit:
Bonsoir Dadi, Oneida,
Un essai en PJ avec ce que j'ai compris:
1- On repère Restaurant xxx en colonne I, on extrait le nom du resto, la date et la Ref en dessous.
2- Tant qu'un nouveau resto n'est pas apparu alors on met en colonne A la date et en B la Ref.
3- Je ne remplis A et B que lorsque C est non vide.

VB:

Sub CompleteFeuille() Dim DL%, L%, L2% DL = [C65500].End(xlUp).Row Range("A1:B" & DL).ClearContents tablo = Range("A1:I" & DL + 2) For L = 1 To UBound(tablo) If tablo(L, 9) Like "Restaurant*" Then Resto = Mid(tablo(L, 9), 12) LaDate = Right(tablo(L + 2, 9), 10) For L2 = L + 4 To UBound(tablo) - 2 If tablo(L2 - 1, 3) Like "(4) Service fees =*" = True Then Exit For If tablo(L2, 3) <> "" Or tablo(L2 + 1, 3) Like "(4) Service fees =*" = True Then tablo(L2, 1) = LaDate tablo(L2, 2) = Resto End If Next L2 End If Next L [A1].Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo End Sub

Bonjour,
Y a un bleme, Dadi147, dans son dernier post, montre une image de son fichier nouveau model qui ne correspond pas au fichier mis dispo.
Les explications fournies designent des cellules de couleurs qui n'existent pas dans le fichier mis a dispo.
Je veux un fichier nouveau model, simple non!

Dadi147,
Vous comprenez ce que j'attends de vous?

sylvanu · 18 Janvier 2023

Bonjour Oneida,
J'ai fini par comprendre.

On cherche en colonne I le mot Restaurant xxx ( Ligne N par ex )
On prend la première date à la ligne N2
On prend la ref en ligne N+3
On met la date en colonne A, et la Ref en colonne B tant qu'un nouveau resto n'est pas trouvé.
Ensuite bis repetita jusqu'à la fin. ( voir PJ du post #19 )
Je sais, ce fut laborieux !

Oneida · 18 Janvier 2023

sylvanu à dit:
Bonjour Oneida,
J'ai fini par comprendre.
On cherche en colonne I le mot Restaurant xxx ( Ligne N par ex )
On prend la première date à la ligne N2
On prend la ref en ligne N+3
On met la date en colonne A, et la Ref en colonne B tant qu'un nouveau resto n'est pas trouvé.
Ensuite bis repetita jusqu'à la fin. ( voir PJ du post #19 )
Je sais, ce fut laborieux !

Re,

On cherche en colonne I

A condition quelle existe.
Pour avancer sur ce schmilblic:
J'ai insere deux colonnes a partir de la colonne K pour avoir les donnees de la colonne E en copier/coller en I
La date est a prendre colonne H cellule "sales" -1, fichier original donc (L+6,8)

Vous remplissez A:B 4 ligne trop tot
Vous ne remplissez pas les cellules A:B si cellule C vide, ce qui n'est pas dans le fichier mis a dispo
Autrement le temps d'execution est le meme que le code que j'ai fourni
Vous ne remplissez pas les cellules A:B si C vide, ce qui n'est pas prevu dans fichier original, c'est un plus

sylvanu · 18 Janvier 2023

Sur la PJ du post #19 :

Oneida à dit:
Vous remplissez A:B 4 ligne trop tot

Non, je commence en ligne 9.

Oneida à dit:
Vous ne remplissez pas les cellules A:B si C vide, ce qui n'est pas prevu dans fichier original,

Non pas dans cette PJ, il n'y a aucun trou quand C est vide.

Mais le principal, c'est que cette solution va bien au demandeur. Comme je n'ai pas tout compris je me suis borné à suivre les images.

Oneida · 18 Janvier 2023

sylvanu à dit:
Sur la PJ du post #19 :

Non, je commence en ligne 9.

Non pas dans cette PJ, il n'y a aucun trou quand C est vide.

Mais le principal, c'est que cette solution va bien au demandeur. Comme je n'ai pas tout compris je me suis borné à suivre les images.

Re,
Pas trou, ben si:

VB:

If tablo(L2, 3) <> "" Or tablo(L2 + 1, 3) Like "(4) Service fees =*" = True Then
                    tablo(L2, 1) = LaDate
                    tablo(L2, 2) = Resto
                End If

sylvanu · 18 Janvier 2023

Re,

Oneida à dit:
Pas trou, ben si:

Sur la Pj du post #19, j'utilise un array, et ça commence bien en ligne 9 :

VB:

For L = 1 To UBound(tablo)
   If tablo(L, 9) Like "Restaurant*" Then
       Resto = Cells(L + 3, 9)
       LaDate = Split(Split(tablo(L + 2, 9), "Date ")(1), " To")(0)

J'ai un peu de mal à vous suivre.

Dadi147 · 18 Janvier 2023

sylvanu à dit:
Re,

Sur la Pj du post #19, j'utilise un array, et ça commence bien en ligne 9 :

VB:

For L = 1 To UBound(tablo) If tablo(L, 9) Like "Restaurant*" Then Resto = Cells(L + 3, 9) LaDate = Split(Split(tablo(L + 2, 9), "Date ")(1), " To")(0)

J'ai un peu de mal à vous suivre.

Bonjour à tous, pouvez-vous expliquer cette ligne? Juste pour apprendre de vos expériences, pour les mettre en œuvre sur d'autres fichiers.

VB:

LaDate = Split(Split(tablo(L + 2, 9), "Date ")(1), " To")(0)

sylvanu · 18 Janvier 2023

Bonjour dadi,
Split permet de séparer une chaine avec un séparateur et met l'ensemble dans un tableau.
Prenons comme ex la ligne 6 de votre fichier :
From Date 15/12/2022 To Date 16/12/2022

Le premier split avec comme séparateur "date" donne:

ce qui m'intéresse c'est le 15/12 en Tablo1(1), donc j'utilise Tablo1 que je split avec " To", et j'obtiens :

et je récupère la date dans Tablo2(0)

On a donc :

Code:

 Tablo1 = Split(tablo(L + 2, 9), "Date ")
 Tablo2 = Split(Tablo1(1), " To")
 
 et donc en remplaçant on obtient :
 
 LaDate = Split(Split(tablo(L + 2, 9), "Date ")(1), " To")(0)

Ca simplifie l'écriture.

XL 2016 Récupérer les données de nom et de date VBA

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums