XL 2016 Envoi si Condition

[Dymouille]

Bonjour,

J'aimerais copier mes lignes en fonction de la catégorie de cette dernière (ici Boisson dans la colonne G)
donc je met en place une condition basique mais je ne sais pas pourquoi ca ne marche pas, ca ne rentre même dans le If

Merci d'avance

Sub Try()
Dim Chemin As String, Fichier As String, J As Long, i As Integer, Cel As Range
Dim T1(1 To 1, 1 To 6) As String           ' Tableau qui va contenir les infos voulues d'une ligne
Dim ws As Worksheet

  Application.ScreenUpdating = False        ' Bloque le raffraichissement écran (on ne voit rien de ce qui se passe
  Set ws = ActiveSheet                      ' Plus facile à manipuler
  Chemin = ThisWorkbook.Path & Application.PathSeparator    ' Chemin des fichier
  Fichier = "Copie de RupturesIntranet.xlsx"          ' Nom du fichier
  If Dir(Chemin & Fichier) = "" Then        ' On vérifie si le chemin existe
    MsgBox "Fichier introuvable" & vbCr & Fichier ' Si absent on le signale
    Exit Sub                                      ' Et on s'en va
  End If
  With Workbooks.Open(Chemin & Fichier)                     ' On ouvre le fichier
    With .Sheets("Switchs")                                         ' On va "travailler" avec la page Switchs
      For J = 2 To .Range("B" & Rows.Count).End(xlUp).Row
        For i = 1 To UBound(T1, 2)        ' Pour chaque élément du tableau
          ' On le remplit avec les infos dela bonne colonne (Regarde l'aide de Choose ou de CHOISIR() dans une page Excel)
          T1(1, i) = .Cells(J, Choose(i, "C", "G", "D", "H", "J", "N"))
        Next i
        ' On recherche dans le fichier principal si ce matricule existe
        Set Cel = ws.Columns("A").Find(What:=.Range("C" & J), LookIn:=xlValues, lookat:=xlWhole)

      If Range("G" & J).Value = "Boisson" Then
        If Not Cel Is Nothing Then
          ' Le matricule existe on remplace les données
          Cel.Resize(1, UBound(T1, 2)) = T1
        Else
          ' ' Le matricule n'existe on écrit les données à la fin
          ws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, UBound(T1, 2)) = T1
        End If
      End If
      Next J
    End With
    .Close savechanges:=False   ' Ferme le fichier sans le sauvegarder
  End With

End Sub

 

[soan]

Bonsoir Dimouille,

Attention : le code VBA ci-dessous est juste un essai ! (➯ à tester avec prudence !)

Option Explicit

Sub Try()
  Dim ws As Worksheet, Chemin$, Fichier$, cel As Range, j&, i%
  Dim T1(1 To 1, 1 To 6) As String        ' Tableau qui va contenir les infos voulues d'une ligne

  Application.ScreenUpdating = 0          ' Gel de l'écran => c'est plus rapide
  Set ws = ActiveSheet                    ' Plus facile à manipuler
  Chemin = ThisWorkbook.Path & Application.PathSeparator  ' Chemin des fichier
  Fichier = "Copie de RupturesIntranet.xlsx"              ' Nom du fichier
  If Dir(Chemin & Fichier) = "" Then      ' On vérifie si le chemin existe
    MsgBox "Fichier introuvable" & vbCr & Fichier ' Si absent on le signale
    Exit Sub                                      ' Et on s'en va
  End If
  With Workbooks.Open(Chemin & Fichier)   ' On ouvre le fichier
    With .Worksheets("Switchs")           ' On va "travailler" avec la page Switchs
      For j = 2 To .Cells(Rows.Count, 2).End(3).Row
        For i = 1 To UBound(T1, 2)        ' Pour chaque élément du tableau
          ' On le remplit avec les infos de la bonne colonne (voir l'aide de Choose ou CHOISIR()
          T1(1, i) = .Cells(j, Choose(i, "C", "G", "D", "H", "J", "N"))   ' dans une page Excel)
        Next i
        ' On recherche dans le fichier principal si ce matricule existe
        Set cel = ws.Columns(1).Find(.Cells(j, 3), , -4163, 1, 1)
        If LCase$(Trim$(ws.Cells(j, 7))) = "boisson" Then
          If Not cel Is Nothing Then
            ' Le matricule existe => on remplace les données
            cel.Resize(1, UBound(T1, 2)) = T1
          Else
            ' Le matricule n'existe pas => on écrit les données à la fin
            ws.Cells(Rows.Count, 1).End(3).Offset(1).Resize(1, UBound(T1, 2)) = T1
          End If
        End If
      Next j
    End With
    .Close savechanges:=False  ' Ferme le fichier sans le sauvegarder
  End With

End Sub

soan

 

[Dymouille]

Bonsoir Soan,

Tout d'abord merci beaucoup pour le temps accordé,
je testerai tout ça demain matin !
j'ai quelques petites questions concernant ton travail,

- Pourquoi avoir mis des "$" sur les variables fichier et chemin ? de même pour "j" et "i" ?
- Pourquoi avoir mis "-4163" ici :
Set cel = ws.Columns(1).Find(.Cells(j, 3), , -4163, 1, 1)
- Pourquoi avoir remplacer les "xlUp" par des 3 ?

Merci d'avance !

 

[soan]

Bonjour Dymouille,

Dim Chemin$ est la même chose que Dim Chemin As String ; c'est plus court à écrire
et à lire ; idem pour Fichier$ : « $ » utilisé dans une instruction Dim = As String

Dim j& est la même chose que Dim j As Long ; c'est plus court à écrire et à lire

Dim i% est la même chose que Dim i As Integer ; devine... mais oui, c'est ça :
c'est aussi plus court à écrire et à lire

Set cel = ws.Columns(1).Find(.Cells(j, 3), , -4163, 1, 1)
a) -4163 est la constante numérique de xlValues
b) le 1 qui est à droite signifie : xlWhole
c) le deuxième 1 signifie : xlByRows
dans les 3 cas : le nombre est plus court à écrire et à lire

j'ai remplacé les xlUp par des 3 car c'est plus court à écrire et à lire ; oui, je sais :
j'suis un gros paresseux, et j'privilégie toujours une notation courte plutôt qu'une
notation plus longue (quand elles sont équivalentes) ; de plus, et c'est un gros
détail qui a son importance : j'tape pas vite sur mon clavier (à une allure de
tortue, comparée à la vitesse d'une sténo-dactylo professionnelle), alors quand
j'peux faire l'économie de quelques caractères à frapper laborieusement avec
seulement deux ou trois doigts, j'hésite pas une seconde !

je sais c'que tu vas m'dire : « oui, mais les notations longues étaient déjà tapées
dans mon code VBA » ; réponse : « oui, mais partout où c'était possible d'écrire
une notation plus courte, j'ai voulu te le montrer, pour démo ; et ça te sera très
utile si tu as une vitesse de frappe aussi phénoménale que la mienne ! »

soan

 

[Dymouille]

Bonjour Soan,

Eh bien ! j'essayerai d'y penser pour les prochaines fois (même si j'écris plutôt vite héhé)
Merci de l'astuce !

Je viens de tester le code, et il se passe... rien !
après plusieurs tests c'est la ligne

If LCase$(Trim$(ws.Cells(j, 7))) = "boisson" Then

qui semble ne rien retourner, même en appliquant la bonne colonne dans le Cells, ca ne me retourne rien !

 

[soan]

@Dymouille

j'viens d'lire ton post, d'où le retard de ma réponse (j'étais occupé sur d'autres sujets).

ce que j'ai proposé était juste un essai ; je l'avais bien précisé ici :

car sans avoir ton fichier, c'est pas évident ! en Cells(j, 7), il y a la Catégorie ; ok ;
mais qu'y a-t-il dans une cellule de cette colonne ? une Catégorie ; ok, ça s'est
entendu ; mais encore ? il se peut qu'une donnée ait des espaces en trop (soit à
gauche, soit à droite, soit les 2 en même temps), d'où le Trim$() ; il se peut qu'il
y aie une différence de casse (lettres majuscules ou minuscules), d'où LCase$(),
avec test sur "boisson" et pas "Boisson" ; tu peux aussi enlever le LCase$() et
remettre "Boisson", mais à condition d'ajouter, en début de module, à droite
de Option Explicit cette instruction : Option Compare Text ; oui, je sais, c'est
un peu surprenant, au premier abord : on s'demande c'que ça vient faire là ;
si tu regardes dans l'Aide VBA, j'suis sûr que tu comprendras mieux.

oh, et puis, j'dois t'avouer quelque chose : si j'ai mis ws.Cells(j, 7), c'est un peu
au hasard, car vois-tu, sans ton classeur, c'est un peu difficile de savoir quelles
feuilles sont concernées ; il faudrait aussi savoir à partir de quelle feuille
tu lances ta macro ; et si c'est toujours cette même feuille ; pourquoi ?
car si cette feuille est toujours la feuille active, alors ça devient inutile
de la référencer explicitement : en effet, sans référence de feuille explicite,
alors la feuille concernée est implicitement la feuille active ; comme dans
ton code VBA, tu as mis Range("G" & J) sans préciser de référence de feuille,
je me suis dit que, peut-être, ta macro ne marche pas car là, ce n'est pas sur
la feuille active ? alors si c'est ni sur la feuille active, ni sur ws, ça doit être
sur une autre feuille, mais laquelle ? encore une fois, sans avoir ton fichier,
ben on ne peut faire que des conjectures ! tu comprends, maintenant,
pourquoi j'ai écrit aussi : « à tester avec prudence ! »

j'aurais bien aimé avoir un don de double-vue, au moins pour compenser
ma lamentable vitesse de frappe, mais à ma connaissance, aucune fée ne
s'est penchée sur mon berceau pour m'offrir un don quelconque ! (j'ai pas
d'chance, hein ? )

si tu envoies ton fichier (sans données confidentielles), j'essaierai d'voir si j'peux
faire quelque chose. attention : c'est sans garantie ! ... peut-être que si j'reçois la visite
d'une fée ? mais à mon âge, ça m'étonnerait ! ça fait bien longtemps que j'suis plus dans
mon berceau ! c'était bien douillet, pourtant... et en plus, en c'temps-là, j'avais aucune
facture à payer : ni pour le loyer, ni pour l'EDF, ni pour l'eau... ; enfin, bref !

à part ça, et sans être bêtement jaloux, j'suis ravi pour toi que ta vitesse de frappe
soit meilleure que la mienne !

soan

 

[Dymouille]

Re Soan !

Aucun problème
C'est vrai.. c'est vrai.. excuse moi !
Mais détrompes toi, une fée s'est bien penchée sur ton berceau pour t'offrir un don : l'humour !

J'ai donc créé 3 petits fichiers spécialement pour l'occas' !

- Envoi : il contient les données à exporter
- ExcelForum : il contient la Macro, c'est le fichier qui lie les deux classeurs
- Recu : il va recevoir les données


Le fichier Recu doit être fermer quand on lance la Macro !

J'ai un autre petit blocage aussi, j'aimerais envoyer les lignes seulement ou le tarif est présent, parce qu'actuellement si j'ai déjà un tarif dans le fichier "Recu" et que dans le fichier "Envoi" il n'y en a pas pour cette même ligne (avec le même code1), la valeur du fichier "Envoi" va remplacer celle du fichier "Recu", je me retrouve donc avec une cellule vide ou figurait avant un jolie petit tarif

Merci d'avance !

 

[Dymouille]

Oups la boulette, j'avais envoyer les mauvais fichiers

Comme ca c'est plus cohérent :

 

[soan]

Bonjour Dymouille,

je m'disais bien qu'ça m'paraissait bizarre !

j'avais déjà commencé à travailler sur tes fichiers ; va falloir que j'recommence
avec tes nouveaux fichiers ; ça va m'prendre longtemps, alors ne t'étonnes pas
si ça va beaucoup tarder !

soan

 

[Dymouille]

Bonjour Soan,

la grosse boulette ahah, je suis désolé pour la perte de temps !
j'avance aussi de mon côté et te tiens au courant !

Merci !

 

[soan]

@Dymouille

* ton 2ème fichier "envoi.xlsx" était le même que le 1er fichier "envoi.xlsx" ;
donc c'était inutile de l'envoyer de nouveau.

* ton 2ème fichier "reçu.xlsx" n'a qu'une feuille vide ! donc j'ai utilisé le 1er fichier
"reçu.xlsx" qui a déjà des données ; cela surtout car dans ton post #7, tu as écrit :
« la valeur du fichier "Envoi" va remplacer celle du fichier "Recu", je me retrouve
donc avec une cellule vide ou figurait avant un joli petit tarif »

* ton 2ème fichier "ExcelForum.xlsm" n'a plus aucune donnée, et tu a ajouté
un bouton pour lancer la macro ; donc pour moi, le plus simple était de
continuer avec le 1er fichier "ExcelForum.xlsm", pour garder le même code
VBA que j'étais en train de faire ; j'ai juste supprimé toutes les données de
la feuille, et ajouté « Bouton 1 ».

attention : pour tes tests, utilise les 3 fichiers de ce post !
voir ci-dessous la procédure à suivre.

----------------------------------------------------------------------------------------

* les 3 fichiers doivent être dans le même dossier

* le fichier "envoi.xlsx" est fermé
* le fichier "reçu.xlsx" est fermé

* ouvre le fichier "ExcelForum.xlsm"
* clique sur "Bouton 1" ; ou fais Ctrl e (au choix)

* après exécution, "ExcelForum.xlsm" est fermé
* tu es sur "envoi.xlsx" ; regarde-le
* va sur "reçu.xlsx", et regarde-le

problème : la macro fait bien son travail, mais les données
pour pouvoir s'en rendre compte ne sont pas adéquates !!!
à toi de tester avec d'autres données plus représentatives.

----------------------------------------------------------------------------------------

en gros, la macro fait ceci :

* elle ouvre le fichier "reçu.xlsx", s'il est présent ; sinon : message, et arrêt
* elle ouvre le fichier "envoi.xlsx", s'il est présent ; sinon : message, et arrêt

(donc la suite est faite uniquement si les 2 fichiers ont été ouverts)

* elle lit toutes les lignes de "reçu.xlsx", mais ne s'occupe que des lignes
dont la catégorie est "Boissons" ; pour une ligne avec "Boissons" :

* recherche de "Code 1" en colonne A de la feuille de "reçu.xlsx"
* si non trouvé : ajout de la ligne sous les lignes déjà présentes
* si trouvé : écriture du Prix, mais seulement s'il n'y en avait
pas déjà un ➯ ça évite d'écraser un ancien prix

----------------------------------------------------------------------------------------

je pense que la macro fait bien son travail, mais si c'est pas le cas,
c'était à toi de fournir des données représentatives ; ce n'est pas
mon job d'inventer de nouvelles données adéquates pour vérifier
si c'est ok ou non !

s'il faut faire une correction de la macro, je t'aiderai, mais à condition
que tu envoies des données représentatives : de nouvelles lignes
devront être ajoutées si une ligne avec "Boissons" n'existe pas déjà
sur la feuille de "reçu.xlsx" ; et pour une ligne avec "Boissons" dont le
"Code 1" existe déjà, le Prix de "envoi.xlsx" doit être noté seulement
s'il n'y avait pas déjà un ancien prix (donc 2 cas à vérifier).

je vais devoir m'absenter longtemps ➯ je lirai ta réponse ce soir.

soan

 

[Dymouille]

Re Soan !

C'est : PARFAIT !
il manque juste un petit truc, c'est le fait d'envoyer une ligne seulement si un tarif est présent dans la feuille Envoi.
j'imagine que c'est avec un

If Not .Offset(, 7) Is Nothing Then

mais comment le combiner avec ton code.. la je bloque

Petite incompréhension au niveau de ces deux lignes aussi

  nlm = Rows.Count: lg2 = ws.Cells(nlm, 1).End(3).Row + 1
  dlg = Cells(nlm, 1).End(3).Row

Merci beaucoup !!

 

[soan]

@Dymouille

ci-dessous, nouvelle version du fichier ; la sub privée OpenFile() est inchangée ;
j'ai modifié uniquement la sub Saloute() ; il y a 2 lignes de Dim au lieu d'une
seule, et elles sont un peu plus bas, juste avant Set ws = ... ; j'ai ajouté une
variable : prx As Range ; puis y'a plusieurs modifs sous With Cells(lg1, 1).
(code VBA non testé, mais ça devrait aller )

nlm = Rows.Count : nombre de lignes maxi = n° ligne maxi = 1 048 576
pour les fichiers .xlsm et .xlsx ; 65535 pour les anciens .xls

lg2 = ws.Cells(nlm, 1).End(3).Row + 1 : lg2 = n° ligne pour la feuille de
destination, donc sur la feuille du fichier "reçu", grâce à ws : dernière
ligne utilisée, selon la colonne A (car le 1er 1 = 1ère colonne = col A) ;
.End(3) : idem que .End(xlUp) ; + 1 ➯ lg2 est initialisé avec le n° de la
1ère ligne vide qui est juste sous la dernière ligne utilisée ; ensuite,
après chaque écriture d'une ligne en feuille de destination, il sera
incrémenté de 1 : lig2 = lig2 + 1 ; note bien que l'initialisation de lg2
est faite avant d'entrer dans la boucle For lg1 = 2 To dlg, et bien sûr,
l'incrémentation de lg2 est faite dans cette boucle.

dlg = Cells(nlm, 1).End(3).Row : dlg = n° dernière ligne utilisée sur la
feuille active (donc sur la feuille du fichier "envoi"), selon colonne A ;
là aussi : 1 = 1ère colonne = col A ; .End(3) : idem que .End(xlUp)

soan

 

[Dymouille]

Bonjour Soan,

Ca marche niquel !

Un grand merci à toi !