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

Dadi147

XLDnaute Occasionnel
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
 

Pièces jointes

  • TEST1(4).xlsm
    50.1 KB · Affichages: 9

Oneida

XLDnaute Impliqué
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. ;)
Re,
Pas grave.
1: la date est normalement en colonne H, si nous respectons la logique colonne E pour donnees et D pour la Date
2: Il n'y a pas d'infos colonne Ax:Bx si la cellule Cx est vide
3: Vous commencez a remplir la tablo en A1 ok et les infos A:B en ligne 5 pas 9 ou 83 ou ....
votre fichier ou j'ai simplement
mis les colonnes avec les infos liees au changement demandees par Dadi147,
modifie votre pour la Date afin d'avoir un resultat
Vous n'avez pas change de structure la feuille Reference?
 

Pièces jointes

  • TEST1(4) (V2) (1).xlsm
    94.7 KB · Affichages: 5

job75

XLDnaute Barbatruc
Bonjour Dadi147, Oneida, sylvanu; le forum,

Il aurait été judicieux de donner le lien de ce fil où je précisais que ma macro était rapide :

https://excel-downloads.com/threads...gne-de-la-facture-vba.20072971/#post-20557409

Cela aurait sans doute évité d'en être au 32ème post !

Et l'adaptation aux nouvelles données n'est pas vraiment difficile :
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(.[I:I], "Restaurant*") 'changé en colonne ("i")
    ReDim a(nmax) 'base 0
    derlig = .Range("K" & .Rows.Count).End(xlUp).Row + 5 'changé en colonne ("K")
    a(nmax) = "I" & derlig 'dernier élément
    tablo = .Range("I1:J" & derlig) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "I" & 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(3)), 11, 10)
        h = .Range(a(n + 1)).Row - 5 - c(5).Row
        If h > 0 Then
            If IsDate(dat) Then c(6, -7).Resize(h) = CDate(dat)
            c(6, -6).Resize(h) = c(4)
        End If
    Next n
End With
End Sub
Bien sûr il faut avoir compris comment fonctionnent les indices x et y d'une cellule c(x, y).

A+
 

Pièces jointes

  • TEST1(4).xlsm
    38.6 KB · Affichages: 2

Oneida

XLDnaute Impliqué
Bonjour Dadi147, Oneida, sylvanu; le forum,

Il aurait été judicieux de donner le lien de ce fil où je précisais que ma macro était rapide :

https://excel-downloads.com/threads...gne-de-la-facture-vba.20072971/#post-20557409

Cela aurait sans doute évité d'en être au 32ème post !

Et l'adaptation aux nouvelles données n'est pas vraiment difficile :
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(.[I:I], "Restaurant*") 'changé en colonne ("i")
    ReDim a(nmax) 'base 0
    derlig = .Range("K" & .Rows.Count).End(xlUp).Row + 5 'changé en colonne ("K")
    a(nmax) = "I" & derlig 'dernier élément
    tablo = .Range("I1:J" & derlig) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "I" & 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(3)), 11, 10)
        h = .Range(a(n + 1)).Row - 5 - c(5).Row
        If h > 0 Then
            If IsDate(dat) Then c(6, -7).Resize(h) = CDate(dat)
            c(6, -6).Resize(h) = c(4)
        End If
    Next n
End With
End Sub
Bien sûr il faut avoir compris comment fonctionnent les indices x et y d'une cellule c(x, y).

A+
Bonjour,
Il aurait été judicieux de donner le lien de ce fil où je précisais que ma macro était rapide :
Ben, le demandeur n'en a jamais parle, pouvais pas deviner.
Dans un de mes posts du debut, j'ai mis le temps d'exec de votre code (puisque c'est le votre.) et "le mien" qui sont identiques a la suite de ma modif du remplissage du tablo a(), donc pas de modif a faire sur votre code sauf remplissage A:B trois lignes trop tot, ceci avec le fichier que nous avons.
Nous avons continue syvalnu et moi-meme sur une solution de syvalnu en attendant que Dadi147 se manifeste
Mais nous aurions du, peut-etre, creer un nouveau sujet afin de ne pas vous "froisser" voir "courousser"
 

Oneida

XLDnaute Impliqué
Notez qu'en rédigeant la macro je savais bien qu'on pouvait ne faire qu'une seule boucle.

Mais il m'a semblé que 2 boucles permettent une présentation plus claire, sans prendre plus de temps.
Bonjour,
Une seule boucle, c'est ce que je voulais aussi faire.
Quand j'ai vu que Dadi147 n'avait pas ecrit ce code et qu'il avait quelques difficultes a faire cette modif assez simple, j'ai laisse le code tel quel.
La discution est longue du fait que Dadi147 n'a pas voulu donner un fichier avec les bonnes colonnes. Ayant eu pas mal de surprises avec des demandes de modif sur des structures de fichier soit disant identiques, je suis assez prudent
Maintenant, je me mets en stand-bye sur cette discution
Content d'avoir communique avec vous
Salutations
 

Statistiques des forums

Discussions
312 089
Messages
2 085 206
Membres
102 819
dernier inscrit
Michew13