Question de débutant Macro excel

[KisskooOool]

Bonjour,
Je suis totalement débutant en macro sur excel.
Je connais un peu excel et ses formule, mais les macros, rien du tout.
Je sollicite donc votre aide :

J'ai "fait" un code, ou plutot recopier des codes de diverses sources internet pour arriver à mes fins.
J'ai donc réussi à obtenir ce code que je comprend à peu près puisque je l'ai modifier.
Le voici :

Option Explicit
Const Vcol As Long = 5



Sub Itemscommuns() 'FLA 24.03.08
' COMPARER 1 COLONNE DANS 2 FEUILLES, FLAGER
' LES ITEMS COMMUNS AUX 2 COLONNES
' INSCRIRE LES LIGNES CORRESPONDANTES DANS UNE FEUILLE
' CRITÈRE DE COMPARAISON :ITEMS EN COLONNE A; À DÉFINIR
Dim Tablo As Variant, Tabb As Variant, Tabc As Variant
Dim Sbd1 As Worksheet, Sbd2 As Worksheet
Dim I&, J&, Ka&, Kb&, Kc&, Cola&, Colb&
Dim Fichier1$, cell1 As Range
Dim Fichier2$, cell2 As Range

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set Sbd1 = Feuil2
Set Sbd2 = Feuil3
Ka = Feuil2.Cells(65536, 1).End(xlUp).Row
Kb = Feuil3.Cells(65536, 1).End(xlUp).Row
Cola = 1
Colb = 1
' RAZ TRAITEMENT PRECEDENT
Feuil7.Range("A1").Offset(1, 0).Resize(Ka + Kb, Vcol).ClearContents

' CHARGEMENT DANS TABLEAUX DES DATAS À COMPARER
Tablo = Feuil2.Cells(2, 1).Resize(Ka, Cola).Value
Tabb = Feuil3.Cells(2, 1).Resize(Kb, Colb).Value
ReDim Tabc(1 To UBound(Tablo), 1)
' COMPARAISON DES DATAS CHARGEES DANS LES TABLEAUX
For I = LBound(Tablo) To UBound(Tablo)
For J = LBound(Tabb) To UBound(Tabb)
If Tablo(I, 1) = Tabb(J, 1) Then
Tabc(I, 1) = Tablo(I, 1)
End If
Next J
Next I
Kc = 1
' RESTITUTION DES ITEMS COMMUNS EN FEUIL7
Feuil7.Cells(1, 1) = Feuil2.Cells(1, 1)
For I = LBound(Tabc) To UBound(Tabc)
If Tabc(I, 1) <> vbNullString Then
Feuil7.Cells(Kc + 1, Cola) = Tabc(I, 1)
Kc = Kc + 1
End If
Next
Set Sbd1 = Nothing: Set Sbd2 = Nothing
Erase Tablo: Erase Tabb
' COPIE DES ITEMS COMMUNS DANS FEUIL7
Call Transfertcommuns
Erase Tabc
Application.GoTo reference:=Feuil7.Cells(2, 1), Scroll:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Public Sub Transfertcommuns()
' COPIE DES PLAGES DES ITEMS COMMUNS DANS FEUIL7
' COPIE DES DATAS DE LA FEUILLE BASE1
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Tabuniq As Variant, Vardatas As Variant
Dim K&, Kf&, Col&
Col = 1
K = Feuil2.Cells(65536, Col).End(xlUp).Row
Kf = Feuil7.Cells(65536, Col).End(xlUp).Row
Tabuniq = Feuil7.Cells(1, Col).Resize(K, Col).Value
Vardatas = Feuil2.Cells(1, Col).Resize(K, Vcol).Value
For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)

If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil7.Cells(Kf, 2) = Vardatas(K, 2)
Feuil7.Cells(Kf, 3) = Vardatas(K, 3)
Feuil7.Cells(Kf, 4) = Vardatas(K, 4)
Feuil7.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Application.Calculation = xlCalculationAutomatic
Erase Vardatas: Erase Tabuniq
End Sub



Ce code me permet de comparer les feuilles 2 et 3 de mon classeur et de copier les lignes en communs dans la feuille 7

Le probleme est qu'il travail sur les feuilles du claseur en cours, et mon but est de faire ceci sur des feuille situées dans d'autres fichier, sans les ouvrir si possible.

j'ai vu que c'était possible grace à la commande "Workbooks.Open", mais je n'arrive pas à m'en servir par inexpérience.


Merci de votre aide.

[JeanMarie]

Bonjour

Tu vas encore avoir de la lecture, c'est ici
http://www.excel-downloads.com/forum...michelxld.html
recherche dans cette très longue page "Piloter les fichiers fermés"

Si tu as beaucoup de lignes, il est préférable d'ouvrir le fichier.

@+Jean-Marie

[BOISGONTIER]

Bonjour,


Fonction perso matricielle pour obtenir la liste des éléments communs de 2 listes:

Function Communs(champ1, champ2)
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In champ1
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In champ2
    If MonDico1.Exists(c.Value) Then
      If Not mondico2.Exists(c.Value) Then mondico2.Add c.Value, c.Value
    End If
  Next c
  i = 1
  Communs = Application.Transpose(mondico2.items)
End Function

Avec classeurs fermés:

Sub essai()
  repertoire = ThisWorkbook.Path
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
      repertoire & "\" & "ADOsource.xls"
  Set rs = cnn.Execute("SELECT nom FROM MaBD WHERE nom<>'' Order By nom")
  tbl = rs.GetRows ' tableau à 2 dimensions on ne récupère pas la première ligne
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  '---
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
      repertoire & "\" & "ADOsource2.xls"
  Set rs = cnn.Execute("SELECT nom FROM MaBD WHERE nom<>'' Order By nom")
  tbl2 = rs.GetRows ' tableau à 2 dimensions on ne récupère pas la première ligne
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  '----
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In tbl
    If Not MonDico1.Exists(c) Then MonDico1.Add c, c
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In tbl2
    If MonDico1.Exists(c) Then
      If Not mondico2.Exists(c) Then mondico2.Add c, c
    End If
  Next c
  i = 1
  [A2].Resize(mondico2.Count, 1) = Application.Transpose(mondico2.items)
End Sub

JB
Formation Excel VBA JB

[KisskooOool]

Merci, j'ai reussi a faire ce que je voulais.

Une autre petite question au passage, puvez vous m'expliquer ce que fais cette partie de code (les parties en gras) :

K = Feuil2.Cells(65536, Col).End(xlUp).Row
Kf = Feuil7.Cells(65536, Col).End(xlUp).Row
Tabuniq = Feuil7.Cells(1, Col).Resize(K, Col).Value
Vardatas = Feuil2.Cells(1, Col + 1).Resize(K + 1, Vcol).Value
For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil7.Cells(Kf, 2) = Vardatas(K, 2)
Feuil7.Cells(Kf, 3) = Vardatas(K, 3)
Feuil7.Cells(Kf, 4) = Vardatas(K, 4)
Feuil7.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Application.Calculation = xlCalculationAutomatic

[Marcel32]

Je ne connais pas grand chose, mais je peux essayer de te renseigner.

Vardatas(x, y) doit être une variable qui est en fait un tableau de x colonnes et y lignes et qui te permet de stocker des données en mémoire.
En faisant varier les valeurs de x et y tu accèdes à la donnée que tu veux stockée dans le tableau.

Feuil7.Cells(a, b) = Vardatas(x, y) permet de mettre, dans la cellule située colonne b ligne a dans la feuille "Feuil7", la valeur contenue dans le tableau Vardatas aux indices x et y.

K = Feuil2.Cells(65536, Col).End(xlUp).Row : en gros ça fait comme si tu positionnais le curseur dans la feuille "Feuil2", sur la ligne numéro 65536 (la dernière ligne possible dans une feuille Excel) de la colonne dont le numéro est contenu dans la variable "Col" et ensuite ça remonte dans cette même colonne jusqu'à la première cellule non vide. Le numéro de ligne de cette cellule est alors mis dans la variable "K".

[BOISGONTIER]

Bonjour,

K = Feuil2.Cells(65536, Col).End(xlUp).Row

Donne le no de la dernière ligne de la colonne Col

For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)

Lbound donne la limite inférieure d'un tableau et Ubound la limite supérieure

Les tableaux

Remarque: les méthodes que j'ai donné avec Dictionnary sont beaucoup plus rapides que ta méthode( 2 boucles emboitées)

Sub Communs()
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A2], [A65000].End(xlUp))
     If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B2], [B65000].End(xlUp))
    If MonDico1.Exists(c.Value) Then
      If Not mondico2.Exists(c.Value) Then mondico2.Add c.Value, c.Value
    End If
  Next c 
  Range("E2:E" & mondico2.Count + 1) = Application.Transpose(mondico2.items)
End Sub

Objet dictionary

JB