XL 2013 connaitre le type de variable tableau un ou 2 dim et le sens

patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
je cherche un moyen efficace de savoir quelle est le type de variable tableau une ou deux dim et est une ligne ou une colonne sans avoir a gérer des erreurs dans un sens ou dans l'autre
@Yeahou a donné un début de piste interessant mais c'est pas full right

VB: 
Sub testy7()
a = [A1:H1].Value
MsgBox oneDim(a)
End Sub

Sub testy8()
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
MsgBox oneDim(a)
End Sub

Sub testy9()
Dim a(0 To 5, 1)
  a(5, 0) = "toto "
MsgBox oneDim(a) & " " & UBound(a, 2)
End Sub

'***********************************************************
'ERREUR!!!!
Sub testy10() ' erreur donne vrai quand base 0
Dim a(0 To 5, 0)
  a(5, 0) = "toto "
 'a(5) = "titi"    'erreur " nombre de dimensions incorect"
Msgbox  oneDim(a) & " " & UBound(a, 2)
End Sub
'***********************************************************

Sub testy11() '
Dim a(0 To 5)
MsgBox oneDim(a)
End Sub

Function oneDim(a)
  oneDim = UBound(a) + 1 - LBound(a) = Application.CountA(a)
End Function

il faudrait le moyen de compter le base 0 et ce sera bon
 
Solution
patricktoulon
re
Bonjour @Yeahou
oui perso moi aussi je l'utilise rarement le ".iserr" de l'app
j'utilise typename par ce que je fait la même chose avec evaluate

pour le coup là il y en a pour tout les goûts

3 écriture différentes

sub de test
VB: 
Dim q(1 To 1000000, 1 To 1)

Sub test0()    'tableau 1 colonne explicite base(1,1)
    MsgBox GetTypeArray(q)
    MsgBox GetTypeArray2(q)
    MsgBox GetTypeArray3(q)
End Sub

Sub testX0()    'tableau 1 colonne explicite base(1,1)
    Dim t
    t = [A1].Resize(1000000, 1).Value
    MsgBox GetTypeArray(t)
    MsgBox GetTypeArray2(t)
    MsgBox GetTypeArray3(t)
End Sub

Sub test1()    'tableau 1 colonne explicite base (1,1)
    t = [A1:A1000000].Value
    MsgBox...
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Ok, alors j'ai pas compris ce que tu cherchais. Pour moi:
- une ligne c'est un tableau du style T(1 to 1 , 1 to 10)
- une colonne c'est un tableau du style T(1 to 10 , 1 to 1)
- une plage c'est un tableau du style T(1 to 5 , 1 to 2)

Donc il fallait:
1 - vérifier que le tableau était bien un tableau à 2 dimensions (objet de l'API)
2 - analyser les UBound et LBound des 2 dimensions pour déterminer si c'est ligne, colonne, plage.

Si ta trouvaille répond à ta question alors c'est parfait.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
le switch est plus correcte comme ça
Code: 
Function GetTypeArray(t)
ReDim tx(LBound(t) To UBound(t), 1)
i = LBound(t) - 1
For Each element In tx: i = i + 1: Next
x = i / 2
GetTypeArray = Switch(x = 1, "ligne", x = UBound(t), "Colonne", x <> UBound(t) And x <> 1, "array")
End Function
mais c'est pas parfait en base 0 j'ai encore des soucis 😳

@Dudu2 non pas plage :1 colonne ou 1 ligne ou un array
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonjour @patricktoulon

patricktoulon à dit:
mais c'est pas parfait en base 0 j'ai encore des soucis 😳
Cliquez pour agrandir...

Le Code Test3 pour la Base 0
Le Code test4 pour la Base 1 (Votre code Donne Colonne, le Mien Array)

Le code que j'ai interprété par rapport au votre @patricktoulon ci-dessous

VB: 
Function GetTypeArraybis(t)
    If LBound(t) = 0 Then
    ' Array Obligatoirement 1 Dimension.
        i = LBound(t) - 1
        x = (((UBound(t) + 1) * 2) - 1) / 2
    Else
    ' Array Obligatoirement 2 Dimensions et Plus...
    ' Soit Une Seule Ligne.
    ' Ou
    ' Soit Une Seule Colone.
    ' Test si (Nb Lignes = 1 Et Nb Colonnes sup 1) OU (Nb Lignes > 1 Et Nb Colonnes = 1)
    ' Pour Test (Lignes ou Colonnes) Pour l'array
        If (UBound(t, 1) > 1 And UBound(t, 2) = 1) Or (UBound(t, 1) = 1 And UBound(t, 2) > 1) Then
            x = UBound(t)
        Else
    ' Array 2 Dimensions et Plus avec :
    ' Avec plus d'une lignes --->> (N Lignes) et Plus d'une Colonnes --->> (N colonnes)
            x = (((UBound(t) + 1) * 2) - 1) / 2
        End If
    End If
GetTypeArraybis = Switch(x = 1, "ligne", x = UBound(t), "Colonne", x <> UBound(t) And x <> 1, "array")
End Function

J'ai tester avec votre fonction.
j'ai ajouter les Compteur cpt pour me repérer est comprendre.
puis créer le code ci-dessus
afin de comparer les Résultat des 2 codes.
- GetTypeArray @patricktoulon
- GetTypeArraybis @laurent950

Code: 
Function GetTypeArray(t)
Dim cpt As Integer
ReDim tx(LBound(t) To UBound(t), 1)
    i = LBound(t) - 1
For Each element In tx
    i = i + 1
    cpt = cpt + 1
Next
    x = i / 2
GetTypeArray = Switch(x = 1, "ligne", x = UBound(t), "Colonne", x <> UBound(t) And x <> 1, "array")
End Function

Puis vos Tests

Code: 
Sub test1()
' Colonne
t = [A1:A10].Value
MsgBox GetTypeArray(t)
MsgBox GetTypeArraybis(t)
End Sub

Sub test2()
' ligne
t = [A1:z1].Value
MsgBox GetTypeArray(t)
MsgBox GetTypeArraybis(t)
End Sub

Sub test()
' Array
t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
MsgBox GetTypeArray(t)
MsgBox GetTypeArraybis(t)
End Sub

Sub test3()
' ARRAY Ligne / Colonne
Dim t(0 To 3, 0 To 4)
MsgBox GetTypeArray(t)
MsgBox GetTypeArraybis(t)
End Sub

Sub test4()
' ARRAY Ligne / Colonne
Dim t(1 To 3, 1 To 4)
MsgBox GetTypeArray(t)     ' @Patricktoulon = Colonne
MsgBox GetTypeArraybis(t)  ' @laurent950    = Array
End Sub

Ca fonctionne même avec celui-ci

VB: 
Sub test5()
t = Array([{1,"a"}], [{2,"b"}], [{ 3,"c" }], [{ 4,"d"}], [{5,"e"}], [{6,"f"}], [{7,"g"}], [{8,"h"}], [{9,"i"}])
MsgBox GetTypeArray(t)
MsgBox GetTypeArraybis(t)
End Sub

A Poursuivre et compléter , votre code est super @patricktoulon super votre idée.
 
Dernière édition:
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
Toujours pas saisi à 100% 💩
@Dudu2 non pas plage :1 colonne ou 1 ligne ou un array
Cliquez pour agrandir...
- une ligne c'est un tableau du style T(1 to 1 , 1 to 10) ou T(0 to 0, 0 to 9)
- une colonne c'est un tableau du style T(1 to 10 , 1 to 1) ou T(0 to 9, 0 to 0)
- un Array c'est un tableau quelconque à 1, 2 (qui ne soit ni ligne ni colonne) ou n dimensions
C'est ça la question ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bon ben là je crois que j'ai trouver un compromis intéressant
a savoir gérer une erreur sauf que celle si est non bloquante dons pas besoins de "on error...."
visiblement mes tests sont bons en base 0 et 1
j'ai aussi viré la boucle for each (c'est Laurent qui m'a donné l'idée)
VB: 
Sub test1()
    t = [A1:A1000000].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test2()
    t = [A1:z1].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test3()
    t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    MsgBox GetTypeArray(t)
End Sub

Sub test4()
    t = Split("toto,titi,riri,fifi", ",")
    MsgBox GetTypeArray(t)
End Sub

Sub test5()
    Dim t(0 To 3, 1)
    MsgBox GetTypeArray(t)
End Sub

Sub test6()
    Dim t(0 To 3, 0)
    MsgBox GetTypeArray(t)
End Sub

Sub test7()
    Dim t(0 To 3)
    MsgBox GetTypeArray(t)
End Sub

Sub test8()
    Dim t(1 To 3)
    MsgBox GetTypeArray(t)
End Sub

Function GetTypeArray(t)
    Dim Tx, X&, Z
    If LBound(t) = 0 Then X = UBound(t) + 1: ReDim Tx(1 To UBound(t) + 1) Else X = UBound(t): Tx = t
    X = X * 2 / 2
    Z = Switch(X = 1, "ligne", X = UBound(Tx), "Colonne", X < UBound(Tx) Or X > 1, "array")
    If Z = "Colonne" And TypeName(Application.Index(t, 2, 1)) = "Error" Then Z = "array"
    GetTypeArray = Z
End Function
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
et pour gagner encore un peu plus en mémoire je redim plus un map du tableau c'est une variable long maintenant

purée ça m'a rendu rend fou ce truc
Code: 
Sub test1()
    t = [A1:A1000000].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test2()
    t = [A1:z1].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test3()
    t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    MsgBox GetTypeArray(t)
End Sub

Sub test4()
    t = Split("toto,titi,riri,fifi", ",")
    MsgBox GetTypeArray(t)
End Sub

Sub test5()
    Dim t(0 To 3, 1)
    MsgBox GetTypeArray(t)
End Sub

Sub test6()
    Dim t(0 To 3, 0)
    MsgBox GetTypeArray(t)
End Sub

Sub test7()
    Dim t(0 To 3)
    MsgBox GetTypeArray(t)
End Sub

Sub test8()
    Dim t(1 To 3)
    MsgBox GetTypeArray(t)
End Sub

Function GetTypeArray(t)
    Dim Tx, X&, Z, x2
    If LBound(t) = 0 Then x2 = UBound(t) + 1: X = x2 Else X = UBound(t): x2 = X
    X = X * 2 / 2
    Z = Switch(X = 1, "ligne", X = x2, "Colonne", X < x2 Or X > 1, "array")
    If Z = "Colonne" And TypeName(Application.Index(t, 2, 1)) = "Error" Then Z = "array"
    GetTypeArray = Z
End Function
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonjour Patrick, Laurent, Dudu,

à lire toutes vos discussions, et sur ce sujet en particulier, je me dis que quelque part, vous nous avez caché que vous êtes plus forts que Bill Gates et toute l'équipe de développement de Microsoft ! 😜​

soan
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour @soan
hoh! non je suis sur que lui sait comment il faut faire et peut être même qu'il y a une fonction ou une méthode cachée , ça serait pas la première fois que je découvre des choses bien cachées dans VB et ou on en parle nulle part

en tout cas ma dernière mouture est stable et répond correctement dans toutes les circonstances

j'adore simplement me creuser la cervelle c'est tout
et surtout faire des codes compatibles pour tous

Think différently and otherwise ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
2 Formes d’écriture de switch/case
VB: 
Function GetTypeArray2(t)
    Dim Tx, X&, Z, x2
    If LBound(t) = 0 Then x2 = UBound(t) + 1: X = x2 Else X = UBound(t): x2 = X
     Z = Switch(X = 1, "ligne", X = x2, "Colonne", X < x2 Or X > 1, "array")
    If Z = "Colonne" And TypeName(Application.Index(t, 2, 1)) = "Error" Then Z = "array"
    GetTypeArray = Z
End Function

Function GetTypeArray(t)
    Dim Tx, X&, Z, x2
    If LBound(t) = 0 Then x2 = UBound(t) + 1: X = x2 Else X = UBound(t): x2 = X
     Select Case True
     Case X = 1: GetTypeArray = "ligne" 'si x= 1 c'est forcement une ligne (sauf array de 1 item)
     Case X = x2 And TypeName(Application.Index(t, 2, 1)) <> "Error": GetTypeArray = "Colonne" 'si x=ubound et lindex ligne2 col1 <>"error alors c'est une colonne
     Case Else: GetTypeArray = "array" 'sinon c'est un array
     End Select
End Function

peut être ajouter un test "IsArray" en début de fonction pour stopper le moulin si autre chose qu’un array/tableau injecté
perso c’était le moteur qui m’intéressait ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
et le bouquet final
on identifie aussi les tableau x lignes et y colonnes implicites ou explicites

sous les deux formes d'ecriture
VB: 
Sub test1() 'tableau 1 colonne explicite
    t = [A1:A1000000].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test2() 'tableau 1 ligne explicites
    t = [A1:z1].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test3() 'array base 0
    t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    MsgBox GetTypeArray(t)
End Sub

Sub test4() 'array par split base 0
    t = Split("toto,titi,riri,fifi", ",")
    MsgBox GetTypeArray(t)
End Sub

Sub test5() 'tableu 2 colonnes implicites
    Dim t(0 To 3, 1)
    MsgBox GetTypeArray(t)
End Sub
Sub test6() 'tableu 4 lignes implicites  1 colonne explicite
    Dim t(0 To 3, 1 To 1)
    MsgBox GetTypeArray(t)
End Sub

Sub test7() 'tableau 4 ligne implicites 1 colonne explicite
    Dim t(0 To 3, 0)
    MsgBox GetTypeArray(t)
End Sub

Sub test8() 'array 4 item implicites
    Dim t(0 To 3)
    MsgBox GetTypeArray(t)
End Sub

Sub test9() 'array 3 items explicites
    Dim t(1 To 3)
    MsgBox GetTypeArray(t)
End Sub

Sub test10() 'tableau 4 lignes explicites et 4 colonnes explicite
    Dim t(1 To 3, 1 To 4)
    MsgBox GetTypeArray(t)
End Sub

les deux modeles
Code: 
Function GetTypeArray(t)
    Dim Tx, X&, Z, x2
    If LBound(t) = 0 Then x2 = UBound(t) + 1: X = x2 Else X = UBound(t): x2 = X
    Z = Switch(X = 1, "ligne", TypeName(Application.Index(t, 2, 2)) <> "Error", "Tableau", X = x2, "Colonne", X < x2 Or X > 1, "array")
    If Z = "Colonne" And TypeName(Application.Index(t, 2, 1)) = "Error" Then Z = "array"
    GetTypeArray = Z
End Function

Code: 
Function GetTypeArray1(t)
    Dim Tx, X&, Z, x2
    If LBound(t) = 0 Then x2 = UBound(t) + 1: X = x2 Else X = UBound(t): x2 = X
    Select Case True
    Case X = 1: GetTypeArray = "ligne"    'si x= 1 c'est forcement une ligne (sauf array de 1 item)
    Case TypeName(Application.Index(t, 2, 2)) <> "Error": GetTypeArray = "Tableau"
    Case X = x2 And TypeName(Application.Index(t, 2, 1)) <> "Error": GetTypeArray = "Colonne"
    Case Else: GetTypeArray = "array"    'sinon c'est un array
    End Select
End Function

vous me direz ce que vous en pensez ( ou pas) comme vous le voulvoul'
;)
 
Dernière édition:
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
@patricktoulon,
J'en pense que c'est une belle réussite pour répondre à ta question. Félicitations ! ;)

Perso je suis plus embêté par mon incapacité à faire marcher ça, mais c'est un autre sujet.
J'ai posté sur stackoverflow.com mais pas de réponse :(.
VB: 
#If VBA7 Then
    Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
    Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Public Sub CopyMemory()
    Dim StrMacro As String
    Dim PtrSrc As Long
    Dim PtrDest As Long
    Dim i1 As Integer
    Dim i2 As Integer
   
    PtrSrc = VarPtr(i1)
    PtrDest = VarPtr(i2)
    i1 = 123
   
Const NATIVEAPI = False

If NATIVEAPI Then
   
    '----------------------------------
    'Native API Call -> Ok works fine !
    '----------------------------------
    'RtlMoveMemory i2, i1, LenB(i1)
    RtlMoveMemory ByVal PtrDest, ByVal PtrSrc, LenB(i1)
   
Else

    '-----------------------------------------
    'ExecuteExcel4Macro Call -> INVALID CALL !
    '-----------------------------------------
    StrMacro = "CALL ('kernel32', 'RtlMoveMemory', 'JJJJ', '" & _
                      PtrDest & "', '" & PtrSrc & "', '" & LenB(i1) & "')"
    'StrMacro = "CALL ('kernel32', 'RtlMoveMemory', 'JJJJ', " & _
                      PtrDest & ", " & PtrSrc & ", " & LenB(i1) & ")"
   
    StrMacro = Replace(StrMacro, "'", """")
    MsgBox StrMacro
    Application.ExecuteExcel4Macro (StrMacro)
   
End If

    MsgBox "i2 = " & i2
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
141
patricktoulon
patricktoulon
cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
212
cathodique
cathodique
patricktoulon
  • Résolu(e)
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
627
patricktoulon
patricktoulon
patricktoulon
  • Question
Autres la fonction similaire
Réponses
11
Affichages
434
patricktoulon
patricktoulon
cathodique
  • Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
R
  • Question
XL 2019 Transpose et limiter nombre de valeur
Réponses
1
Affichages
309
Rabeto
R
E
  • Question
Microsoft 365 Listbox avec plus de 10 colonnes
Réponses
6
Affichages
458
Excellearning
E
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
536
AtTheOne
AtTheOne
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
456
GClaire
G
Chaton77
  • Résolu(e)
Microsoft 365 En VBA : Extraire le mois d'une date d'un tableau
Réponses
7
Affichages
335
Chaton77
Chaton77

Membres actuellement en ligne

11 membres et 97 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 144
Messages
2 116 721
Membres
112 846
dernier inscrit
Filou714