Sujet Précédent Sujet Suivant

Double Comparaison colonne Suite

Résolu/Fermé
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 - Modifié par TintinU2 le 27/10/2015 à 16:32
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 - 9 nov. 2015 à 10:10
Bonjour à tous,

Je viens vous sollicitez encore un petit peu.
J'ai récemment demandé de l'aide dans le Forum pour une comparaison de deux colonnes
https://forums.commentcamarche.net/forum/affich-32670385-double-comparaison-colonne?full

J'ai juste un petit soucie. Avec le code de pijaku, j'ai mes dates qui apparaissent dans un format particulier et impossible de mettre en format date ou plutôt jj/mm/aaaa hh:ss

Avez-vous une idée pour sauvegarder le format des dates?
Si pijaku passe par là, tu es le bien venu :)

Merci d'avance

TintinU2
A voir également:

2 réponses

Réponse 1 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
28 oct. 2015 à 07:45
Bonjour,

J'ai "truandé" un peu dans la macro donnée sur l'autre post, en utilisant des simples quotes dans les dates afin de restituer sous le bon format. Tu dois donc avoir d'autres colonnes de dates, j'aurais du y penser et t'apporter une autre solution.
Laquelle?
Traiter, directement les dates comme le fait Excel, par des nombres à virgule...
Comment fait-on lorsque l'on traite directement avec une plage de cellules dans des tableaux comme ceci : 
   'Enregistrement, en mémoire, des données des deux feuilles
   With Sheets(NOM_FEUIL_EXTRACT)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Extract = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value
      Entete_Cols_Extr = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With
   With Sheets(NOM_FEUIL_BDD)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Bdd = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value
      Entete_Cols_Bdd = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With


Nous avons deux choix :
1- boucler sur toutes les valeurs par lignes et colonnes...

2- utiliser "l'astuce" Excel : Value2
Comme ceci : 
   'Enregistrement, en mémoire, des données des deux feuilles
   With Sheets(NOM_FEUIL_EXTRACT)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Extract = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value2 'ICI
      Entete_Cols_Extr = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With
   With Sheets(NOM_FEUIL_BDD)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Bdd = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value2 'ET LA...
      Entete_Cols_Bdd = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With


Il convient ensuite d'enlever les simples quotes (apostrophes) que j'avais ajouté dans l'ancien code, et on obtient : 
Option Explicit

Sub Compare2colonnes()
Dim SheetRestiBdd As Worksheet, SheetRestiExtr As Worksheet
Dim T_In_Extract(), T_In_Bdd(), T_Out_Extract(), T_Out_Bdd()
Dim Entete_Cols_Extr(), Entete_Cols_Bdd()
Dim Dico_Extract As Object, Dico_Bdd As Object
Dim DLig As Long, DLigTemp As Long, i As Long, Ligne As Long, Cpt_Out_Ectract As Long, Cpt_Out_Bdd As Long
Dim Nb_Col As Integer, j As Integer

   '---------------------------------
   'A ADAPTER :
   Const NOM_FEUIL_EXTRACT As String = "Extraction"
   Const NOM_FEUIL_BDD As String = "Base de donnée"
   Const AJOUT_FEUIL_EXTRACT As String = "Extraction apres macro"
   Const AJOUT_FEUIL_BDD As String = "Bdd apres macro"
   Const NUM_LIGN_DEBUT As Integer = 2
   Const LETTRE_DERNIERE_COLONNE As String = "P"
   '---------------------------------
   
   '---------------------------------
   'Lignes à supprimer après tests
   Dim t As Single
   t = Timer
   '---------------------------------
   
   'création des 2 feuilles de restitution des données
   If Not Feuil_Exist(ThisWorkbook.Name, AJOUT_FEUIL_BDD) Then
      Sheets.Add After:=Worksheets(Worksheets.Count)
      ActiveSheet.Name = AJOUT_FEUIL_BDD
   End If
   If Not Feuil_Exist(ThisWorkbook.Name, AJOUT_FEUIL_EXTRACT) Then
      Sheets.Add After:=Worksheets(Worksheets.Count)
      ActiveSheet.Name = AJOUT_FEUIL_EXTRACT
   End If
   
   'Initialisation des variables
   Nb_Col = Asc(LETTRE_DERNIERE_COLONNE) - Asc("A") + 1
   Set Dico_Bdd = CreateObject("Scripting.Dictionary")
   Set Dico_Extract = CreateObject("Scripting.Dictionary")
   Set SheetRestiExtr = Sheets(AJOUT_FEUIL_EXTRACT)
   Set SheetRestiBdd = Sheets(AJOUT_FEUIL_BDD)
   
   'Enregistrement, en mémoire, des données des deux feuilles
   With Sheets(NOM_FEUIL_EXTRACT)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Extract = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value2
      Entete_Cols_Extr = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With
   With Sheets(NOM_FEUIL_BDD)
      DLig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
      DLigTemp = .Columns(13).Find("*", , , , xlByColumns, xlPrevious).Row
      If DLigTemp > DLig Then DLig = DLigTemp
      T_In_Bdd = .Range("A" & NUM_LIGN_DEBUT & ":" & LETTRE_DERNIERE_COLONNE & DLig).Value2
      Entete_Cols_Bdd = .Range("A1:" & LETTRE_DERNIERE_COLONNE & "1").Value
   End With
   
   'stockage des éléments des colonnes B(2) et M(13) + début traitement
   For i = LBound(T_In_Extract) To UBound(T_In_Extract)
      'T_In_Extract(i, 13) = "'" & T_In_Extract(i, 13) 'avec value2 plus besoin de '
      Dico_Extract(T_In_Extract(i, 2)) = T_In_Extract(i, 13)
   Next i
   For i = LBound(T_In_Bdd) To UBound(T_In_Bdd)
      'T_In_Bdd(i, 13) = "'" & T_In_Bdd(i, 13)
      Dico_Bdd(T_In_Bdd(i, 2)) = T_In_Bdd(i, 13)
      'début traitement
      If Dico_Extract.exists(T_In_Bdd(i, 2)) And Dico_Extract(T_In_Bdd(i, 2)) <> T_In_Bdd(i, 13) Then
      Else
         Cpt_Out_Bdd = Cpt_Out_Bdd + 1
         ReDim Preserve T_Out_Bdd(1 To Nb_Col, 1 To i)
         For j = 1 To Nb_Col
            T_Out_Bdd(j, Cpt_Out_Bdd) = T_In_Bdd(i, j)
         Next j
      End If
   Next i
   
   'fin traitement
   For i = LBound(T_In_Extract) To UBound(T_In_Extract)
      If Dico_Bdd.exists(T_In_Extract(i, 2)) And Dico_Bdd(T_In_Extract(i, 2)) = T_In_Extract(i, 13) Then
      Else
         Cpt_Out_Ectract = Cpt_Out_Ectract + 1
         ReDim Preserve T_Out_Extract(1 To Nb_Col, 1 To i)
         For j = 1 To Nb_Col
            T_Out_Extract(j, Cpt_Out_Ectract) = T_In_Extract(i, j)
         Next j
      End If
   Next i
   
   'restitution des données en feuilles "extract apres macro" et "bdd apres macro"
   With SheetRestiBdd
      .Cells.ClearContents
      .Range("A1").Resize(, UBound(Entete_Cols_Bdd, 2)) = Entete_Cols_Bdd
      .Range("A2").Resize(UBound(T_Out_Bdd, 2), UBound(T_Out_Bdd, 1)) = Application.Transpose(T_Out_Bdd)
   End With
   With SheetRestiExtr
      .Cells.ClearContents
      .Range("A1").Resize(, UBound(Entete_Cols_Extr, 2)) = Entete_Cols_Extr
      .Range("A2").Resize(UBound(T_Out_Extract, 2), UBound(T_Out_Extract, 1)) = Application.Transpose(T_Out_Extract)
   End With
   
   'Ligne à supprimer après tests
   MsgBox Timer - t & " secondes"
End Sub

Function Feuil_Exist(strWbk As String, strWsh As String) As Boolean
'Gestionnaire d'erreur
On Error Resume Next
    '"Test"
    Feuil_Exist = (Workbooks(strWbk).Sheets(strWsh).Name = strWsh)
End Function


Pour finir, si tu veux que VBA traite ton format de colonne, par exemple pour la colonne D (4) : 
Columns(4).NumberFormat = "dd/mm/yyyy hh:mm:ss"
0
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 5
28 oct. 2015 à 09:27
Bonjour pijaku,

Merci beaucoup pour ta réponse.
En effet il y avait un peu de tricherie ;-)

Donc si j'ai bien compris, avec la fonction Value2, j'ai une date qui devient un chiffre à virgule, puis après le traitement, je retransforme en date, ce qui évite tout problème de date.
C'est ça?

Encore merci pour ta réponse pijaku
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754 > TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016
28 oct. 2015 à 10:02
C'est ça.
Par contre, à voir pour les autres colonnes... Tout "texte numérique" sera transformé en nombre...
Risque de souci si tes références sont considérées comme de très grands nombres.
Essaye et reviens nous dire.
0
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 5
28 oct. 2015 à 10:07
En effet j'ai des dates sur les colonnes K,L,M

J'ai donc rajouté pour mes deux feuilles 
Columns(11).NumberFormat = "dd/mm/yyyy hh:mm:ss"
    Columns(12).NumberFormat = "dd/mm/yyyy hh:mm:ss"
    Columns(13).NumberFormat = "dd/mm/yyyy hh:mm:ss"


Que veux-tu dire par très grands nombres?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754 > TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016
28 oct. 2015 à 10:26
Que veux-tu dire par très grands nombres?
Des nombres d'au moins 10 chiffres...
0
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 5 > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
28 oct. 2015 à 10:34
Tu parles des dates dans les colonnes K,Let M ou bien du chiffre de la colonne B?
0
Réponse 2 / 2
TintinU2 Messages postés 79 Date d'inscription lundi 26 octobre 2015 Statut Membre Dernière intervention 8 juillet 2016 5
9 nov. 2015 à 10:10
Bonjour à tous,

Pour répondre au message de pijaku, j'ai testé avec un numéro qui ressemble à T150806-8372, et je constate que la ligne 
.Range("A2").Resize(UBound(T_Out_Extract, 2), UBound(T_Out_Extract, 1)) = Application.Transpose(T_Out_Extract)
ne fonctionne pas

Provient de : 
   'restitution des données en feuilles "extract apres macro" et "bdd apres macro"
   With SheetRestiBdd
      .Cells.ClearContents
      .Range("A1").Resize(, UBound(Entete_Cols_Bdd, 2)) = Entete_Cols_Bdd
      .Range("A2").Resize(UBound(T_Out_Bdd, 2), UBound(T_Out_Bdd, 1)) = Application.Transpose(T_Out_Bdd)
   End With
   With SheetRestiExtr
      .Cells.ClearContents
      .Range("A1").Resize(, UBound(Entete_Cols_Extr, 2)) = Entete_Cols_Extr
      .Range("A2").Resize(UBound(T_Out_Extract, 2), UBound(T_Out_Extract, 1)) = Application.Transpose(T_Out_Extract)
   End With


L'erreur est "Incompatibilité de type", n°13

Est-ce quelqu'un comprend d'où peu venir l'erreur?

Merci d'avance

TintinU2
0

Discussions similaires

comment ecrire un double cote " "
helmii -
[Dal] -

3 réponses