Utiliser les variables tableaux en VBA Excel

Option Explicit
Option Base 0

Sub MonPremierTableau()
    'Définit la taille du tableau et le type de données.
    Dim NomTableau(2) As String
    Dim i As Integer
    
    'Alimente les éléments du tableau
    NomTableau(0) = "a"
    NomTableau(1) = "b"
    NomTableau(2) = "c"
    
    'Boucle sur les éléments du tableau pour lire leur contenu
    For i = 0 To 2
        MsgBox NomTableau(i)
    Next i
End Sub

Option Explicit

Sub MonDeuxiemeTableau()
    'Définit le type de données pour le tableau.
    Dim NomTableau() As String
    Dim i As Integer, j As Integer
    
    i = 2
    'Définit la taille du tableau
    ReDim NomTableau(i)
    
    
    'Alimente les éléments du tableau
    For j = 0 To UBound(NomTableau)
        NomTableau(j) = Chr(65 + j)
    Next j
    
   
    'Boucle sur les éléments du tableau
    For j = 0 To UBound(NomTableau)
        MsgBox NomTableau(j)
    Next j
End Sub

Option Explicit

Sub ExempleTableau_MultiDimensionnel()
    Dim i As Integer, j As Integer
    'Définit le tableau à 2 dimensions ainsi que leur taille.
    Dim VarTab(1 To 3, 1 To 6) As String

    
    For i = 1 To UBound(VarTab, 1) 'boucle sur la 1ere dimension
        For j = 1 To UBound(VarTab, 2) 'boucle sur la 2eme dimension
            'Alimente les éléments du tableaux
            VarTab(i, j) = i & j
            'Lit les éléments du tableau
            Debug.Print VarTab(i, j)
        Next j
    Next i
End Sub

Option Explicit

Sub TriCroissantMulticolonnes()
'Déclare un tableau à 2 dimensions.
Dim Tableau(1 To 4, 1 To 50) As String
Dim i As Integer, j As Integer, y As Integer
Dim indexColTri As Byte
Dim t As Variant
Dim Resultat As String

  
'-----Chargement du tableau -----------------
'Remplit chaque élément avec des lettres aléatoires, entre A et Z
For i = 1 To UBound(Tableau, 2)
    For j = 1 To UBound(Tableau, 1)
        Randomize
        Tableau(j, i) = Chr(Int((26 * Rnd) + 1) + 64)
    Next j
Next i
'--------------------------------------------



'---- Applique un tri sur une des colonnes du tableau -----
'Choisissez la colonne à trier: 1= 1ere colonne , 2= 2eme colonne...etc ...
indexColTri = 1

'On sort si l'index de colonne indiqué (indexColTri) est plus grand que la taille de la première
'dimension dans le tableau.
If indexColTri > UBound(Tableau, 1) Then Exit Sub

For i = 1 To UBound(Tableau, 2)
     For j = 1 To UBound(Tableau, 2) - 1
          
        '---------
        'syntaxe pour le tri de données type Date
        'If CDate(Tableau(indexColTri, j)) > CDate(Tableau(indexColTri, j + 1)) Then
        'Pensez à adapter le type de variable: Dim Tableau(1 To 4, 1 To 50) As Date
        
        'syntaxe pour le tri de données type numérique
        'If CDec(Tableau(indexColTri, j)) > CDec(Tableau(indexColTri, j + 1)) Then
        'Pensez à adapter le type de variable: Dim Tableau(1 To 4, 1 To 50) As Long ...
		        
        'syntaxe pour le tri de données type Texte
        If Tableau(indexColTri, j) > Tableau(indexColTri, j + 1) Then
        '---------
            
            For y = 1 To UBound(Tableau, 1)
                t = Tableau(y, j)
                Tableau(y, j) = Tableau(y, j + 1)
                Tableau(y, j + 1) = t
            Next y
            
        End If
    Next j
Next i
'------------------------------------------------------------


'---- Affiche le résultat dans la fenêtre d'exécution -------
For i = 1 To UBound(Tableau, 2)
    Resultat = ""
    
    For j = 1 To UBound(Tableau, 1)
        Resultat = Resultat & Tableau(j, i) & vbTab
    Next j
    
    Debug.Print Resultat
Next i
'------------------------------------------------------------

End Sub

Option Explicit
Option Base 0

Sub Test()
    'Déclare la variable tableau
    Dim NomTableau() As Single
    Dim i As Integer
    
    'Redéfinit la taille du tableau
    ReDim NomTableau(2)
    'Boucle sur les éléments du tableau pour le remplir
    For i = 0 To UBound(NomTableau)
        NomTableau(i) = (3 + i) / 2
    Next i
    
End Sub

Option Explicit
Option Base 0

Sub Test()
    'Déclare la variable
    Dim NomTableau() As String
    Dim i As Integer
    
    'Définit la taille du tableau
    ReDim NomTableau(5)
    'Boucle sur les éléments du tableau pour le remplir
    'avec les lettres A,B,C,D,E et F
    For i = 0 To UBound(NomTableau)
        NomTableau(i) = Chr(65 + i)
    Next i
    
    'Renvoie la lettre A
    MsgBox "Premier élément du tableau: " & NomTableau(0)
    
    'Redéfinit et réduit la taille du tableau.
    ReDim NomTableau(3)
    
    'Renvoie une chaîne vide: les anciens éléments ont été effacés
    'lorsque la taille du tableau a été redéfinie.
    MsgBox "Premier élément du tableau: " & NomTableau(0)
End Sub

Option Explicit
 
Sub Test()
   Dim NomTableau() As Long
    
    ReDim NomTablau(5)
    'Le "e" a été oublié volontairement pour montrer que contrairement
    'aux variables classiques (scalaires), la procédure ne renvoie pas d'erreur, même
    'si option Explicit à été déclaré: Un deuxième tableau est créé.
    
End Sub

Sub Test()
   Dim NomVariable As Variant
    Dim i As Integer
    
    'Modifie la variable en tableau de type String.
    ReDim NomVariable(1 To 3) As String
    'Alimente les éléments en données String
    For i = 1 To UBound(NomVariable)
        NomVariable(i) = Chr(64 + 1)
    Next i
    
    'Modifie la variable en tableau de type Integer.
    ReDim NomVariable(1 To 2) As Integer
    'Alimente les éléments en données numériques
    For i = 1 To UBound(NomVariable)
        NomVariable(i) = i
    Next i
    
End Sub

Option Explicit

Sub ListeFichiersRepertoire()
    Dim Repertoire As String, Fichier As String
    Dim Tableau() As Variant
    Dim x As Integer, i As Integer
    Dim VerifTab As Variant
    
    'Définit le répertoire pour la recherche
    Repertoire = "C:\Documents and Settings\dossier"
    'Recherche tous les types de fichiers
    Fichier = Dir(Repertoire & "\*.*")
    
    'Boucle sur les fichiers pour récupérer les infos
    Do While Fichier <> ""
        'Incrémente le compteur de fichiers
        x = x + 1
        

        '--- Redéfinit la taille de la dernière dimension du tableau
        ReDim Preserve Tableau(1 To 2, 1 To x)
        '------------------------------------
        
  
        'Récupère le nom du fichier
        Tableau(1, x) = Fichier
        'Récupère  la date et l'heure de création ou de dernière modification.
        Tableau(2, x) = FileDateTime(Repertoire & "\" & Fichier)
        Fichier = Dir
    Loop
    
    
    '--- On vérifie si le tableau est vide
    On Error Resume Next
    'VerifTab va prendre la valeur Empty si le tableau est vide.
    VerifTab = UBound(Tableau)
    On Error GoTo 0
    
    If IsEmpty(VerifTab) Then Exit Sub
    '---
    
    
    'Boucle pour lire le contenu du tableau.
    'UBound(Tableau, 2) permet de récupérer la limite supérieure de la 2eme dimension
    For i = 1 To UBound(Tableau, 2)
        'Inscrit le résultat dans la fenêtre d'exécution (Ctrl+G)
        Debug.Print Tableau(1, i) & " --> " & Tableau(2, i)
    Next i
End Sub

Option Explicit
Option Base 0


Sub Test_LBound()
    Dim NomTableau() As Single
    
    ReDim NomTableau(8)
    
    'Affiche la taille inférieure d'un tableau à taille unique.
    'LBound renvoie 0 car "Option Base 0" est indiqué en tête de module.
    MsgBox LBound(NomTableau, 1)
    'ou plus simplement:
    MsgBox LBound(NomTableau)
End Sub

Option Explicit
Option Base 0


Sub Test_LBound()
    Dim Tab_x() As Long
    Dim Tab_y(1 To 20, 5 To 30) As Integer
    Dim Tab_z(10) As String
    
    ReDim Tab_x(5)
    Debug.Print LBound(Tab_x) 'Renvoie 0
    
    Debug.Print LBound(Tab_y) 'Renvoie 1
    Debug.Print LBound(Tab_y, 2) 'Renvoie 5
    
    Debug.Print LBound(Tab_z) 'Renvoie 0
 
    ReDim Tab_x(4 To 8, 1 To 10, 1 To 20)
    Debug.Print LBound(Tab_x) 'Renvoie 4
    Debug.Print LBound(Tab_x, 3) 'Renvoie 1
End Sub

Option Explicit
Option Base 0


Sub Test_UBound()
    Dim NomTableau() As Single
    
    ReDim NomTableau(8)
    
    'Affiche la taille inférieure d'un tableau à dimension unique.
    'UBound renvoie 8
    MsgBox UBound(NomTableau, 1)
    'ou plus simplement:
    MsgBox UBound(NomTableau)
End Sub

Option Explicit
Option Base 0


Sub Test_UBound()
    Dim Tab_x() As Long
    Dim Tab_y(1 To 20, 5 To 30) As Integer
    Dim Tab_z(10) As String
    
    ReDim Tab_x(5)
    Debug.Print UBound(Tab_x) 'Renvoie 5
    
    Debug.Print UBound(Tab_y) 'Renvoie 20
    Debug.Print UBound(Tab_y, 2) 'Renvoie 30
    
    Debug.Print UBound(Tab_z) 'Renvoie 10
 
    ReDim Tab_x(4 To 8, 1 To 10, 1 To 20)
    Debug.Print UBound(Tab_x) 'Renvoie 8
    Debug.Print UBound(Tab_x, 3) 'Renvoie 20
End Sub

Dim Tableau() As Long
'La variable VarTab doit impérativement être de type Variant.
Dim VarTab As Variant

'
'...La procédure
'

On Error Resume Next
'VarTab va prendre la valeur Empty si le tableau est vide.
VarTab = UBound(Tableau)
On Error GoTo 0

If IsEmpty(VarTab) Then MsgBox "Le tableau est vide"

Option Explicit
Option Base 1


Sub listeDoublonsPlage()
    Dim Plage As Range
    Dim Tableau(), Resultat() As String
    Dim i As Integer, j As Integer, m As Integer
    Dim Un As Collection
    Dim Doublons As String
        
    Set Un = New Collection
    'La plage de cellules (sur une colonne) à tester
    Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)
      
      
    Tableau = Plage.Value
    
    On Error Resume Next
    'boucle sur la plage à tester
    For i = 1 To Plage.Count
    
        ReDim Preserve Resultat(2, m + 1)
        
        'Utilise une collection pour rechercher les doublons
        '(les collections n'acceptent que des données uniques)
        Un.Add Tableau(i, 1), CStr(Tableau(i, 1))
        
        'S'il y a une erreur (donc présence d'un doublon)
        If Err <> 0 Then
            
            'boucle sur le tableau des doublons pour vérifier s'il a déjà
            'été identifié
            For j = 1 To m + 1
                'Si oui, on  incrémente le compteur
                If Resultat(1, j) = Tableau(i, 1) Then
                    Resultat(2, j) = Resultat(2, j) + 1
                    Err.Clear
                    Exit For
                End If
            Next j
                
                'Si non, on ajoute le doublon dans le tableau
                If Err <> 0 Then
                    Resultat(1, m + 1) = Tableau(i, 1)
                    Resultat(2, m + 1) = 1
                    
                    m = m + 1
                    Err.Clear

                End If
        End If
    Next i

    '----- Affiche la liste et le nombre de doublons --------
    For j = 1 To m
        Doublons = Doublons & Resultat(1, j) & " --> " & _
                    Resultat(2, j) & vbCrLf
    Next j
    
    MsgBox Doublons
    
    Set Un = Nothing
End Sub

Option Explicit


Private Sub UserForm_Initialize()
    Dim TabTemp As Variant
    
    'Chargement d'une plage de cellules dans la variable TabTemp
    TabTemp = Range("A1:C10").Value
    
    'Définit le nombre de colonnes pour la ListBox.
    ListBox1.ColumnCount = UBound(TabTemp)
    'Chargement du tableau dans la ListBox
    ListBox1.List() = TabTemp
End Sub

Option Explicit


Private Sub CommandButton1_Click()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim i As Integer, N As Integer
Dim Fichier As String
Dim Tbl() As Variant

'Définit le chemin de la base Access
Fichier = "C:\Documents and Settings\mimi\dossier\dataBase.mdb"
 
'Connection à la base
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
    Fichier & ";"
Set Rs = New ADODB.Recordset
 
'Requête
With Rs
    .ActiveConnection = Cn
    .Open "SELECT * FROM NomTable" _
        , , adOpenStatic, adLockOptimistic, adCmdText
End With
 
'efface les données existantes dans la ListBox
ListBox1.Clear
'Redéfinit le nombre de colonnes dans la listbox en fonction du
'nombre de champs contenu dans le Recordset.
ListBox1.ColumnCount = Rs.Fields.Count
 
'Redimensionne le tableau en fonction du nombre de champs et d'enregistrements
'contenu dans le recordset.
ReDim Tbl(Rs.RecordCount - 1, Rs.Fields.Count)
 
'Boucle sur les enregistrements pour les passer dans le tableau.
Do While Not Rs.EOF
    For i = 0 To Rs.Fields.Count - 1
        If IsNull(Rs.Fields(i).Value) = True Then
            Tbl(N, i) = ""
            Else
            Tbl(N, i) = CStr(Rs.Fields(i).Value)
        End If
    Next i

    N = N + 1
    Rs.MoveNext
Loop

'Transfert le tableau dans la ListBox
ListBox1.List() = Tbl
        
        
'Ferme le RecordSet
Rs.Close
Set Rs = Nothing
'Ferme la connexion
Cn.Close
Set Cn = Nothing
End Sub

Option Explicit


Sub Tri_Tableau()
    Dim Valeur As Integer
    Dim i As Integer
    Dim Cible As Variant
    Dim Tableau() As Single
    
    'Remplissage tableau avec la plage de cellules A1:A10
    ReDim Tableau(0 To 9)
    For i = 0 To UBound(Tableau())
        Tableau(i) = Cells(i + 1, 1)
    Next i
    
    
    Do 'tri décroissant
        Valeur = 0
        
        For i = 0 To UBound(Tableau) - 1
            If Tableau(i) < Tableau(i + 1) Then
                Cible = Tableau(i)
                Tableau(i) = Tableau(i + 1)
                Tableau(i + 1) = Cible
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
    
    'vérification du tri décroissant
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
    Next i
    
    
    'Pour obtenir un ordre croissant, il suffit de boucler du dernier élément
    'du tableau, vers le premier.
    
    'For i = UBound(Tableau) To 0 Step -1
        'Debug.Print Tableau(i)
    'Next i
End Sub

Option Explicit
Option Base 1


Sub TriCroissantTableau()
Dim TabSynthese(20) As Integer
Dim i As Integer, x As Integer, k As Integer
Dim ValTemp As Integer
 
 
For i = 1 To 20
    'Initialisation du générateur de nombres aléatoires, entre 1 et 100
    Randomize
    'Alimente le tableau avec la valeur aléatoire
    TabSynthese(i) = Int((100 * Rnd) + 1)
Next i
 
 
'Applique un tri croissant sur le tableau
For i = 1 To UBound(TabSynthese)
    x = i
 
    For k = x + 1 To UBound(TabSynthese)
        If TabSynthese(k) <= TabSynthese(x) Then x = k
    Next k
 
    If i <> x Then
    ValTemp = TabSynthese(x): TabSynthese(x) = TabSynthese(i): TabSynthese(i) = ValTemp
    End If
Next i
 
 
'contrôle le résultat du tri dans la fenêtre d'execution
For i = 1 To UBound(TabSynthese)
    Debug.Print TabSynthese(i)
Next i
 
End Sub

Option Base 0


Sub Test()
    Dim Tableau() As Integer
    
    ReDim Tableau(2, 4, 8)
    
    MsgBox NombreDimensions(Tableau)
End Sub


Function NombreDimensions(varTab As Variant) As Integer
    Dim Compteur As Integer
  
    If Not IsArray(varTab) Then Exit Function
    
    On Error GoTo Fin
      
    Do
      Compteur = Compteur + 1
      Debug.Print UBound(varTab, Compteur)
    Loop
    
Fin:
    NombreDimensions = Compteur - 1
End Function

Option Explicit


Sub TransfertTableau_FeuilleExcel()
    Dim x As Integer, y As Integer
    Dim i As Integer, j As Integer
    Dim NomTableau() As String
    
    
    'Redéfinit la taille du tableau
    x = 10
    y = 5
    ReDim NomTableau(1 To x, 1 To y)
    
    'Alimente les éléments du tableau
    For i = 1 To x
        For j = 1 To y
            NomTableau(i, j) = i & "-" & j
        Next j
    Next i
    
    'Transfère les éléments du tableau dans la feuille de calcul
    Range(Cells(1, 1), Cells(UBound(NomTableau, 1), UBound(NomTableau, 2))) = NomTableau
End Sub

Option Explicit

Sub creationGraphiqueParTableaux()
    Dim i As Byte
    Dim TabAbscisses(1 To 10) As Integer, TabOrdonnees(1 To 10) As Integer
    
    
    'Initialise le générateur de nombres aléatoires.
    Randomize
    
    For i = 1 To 10
        'Alimente le tableau pour les abscisses.
        TabAbscisses(i) = i
    
        'Alimente le tableau pour les ordonnées.
        'Le Tableau est rempli par des valeurs aléatoires (entre 1 et 50).
        TabOrdonnees(i) = Int((50 * Rnd) + 1)
    Next i
    
    
    'Création graphique
    Charts.Add
    'Définit la localisation du graphique:
    'dans la feuille de calcul (Feuil1 pour cet exemple)
    ActiveChart.Location _
    Where:=xlLocationAsObject, Name:="Feuil1"
    

    'Ajoute une série dans le graphique
    With ActiveChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = TabAbscisses() 'Abscisses
        .SeriesCollection(1).Values = TabOrdonnees() 'Ordonnées
        'Définit le type (Courbe)
        .ChartType = xlLine
        .SeriesCollection(1).Name = "Série aléatoire"
    End With
End Sub