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

patricktoulon · 12 Juin 2021

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

patricktoulon · 20 Juin 2021

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...

Dudu2 · 18 Juin 2021

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.

patricktoulon · 18 Juin 2021

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

laurent950 · 19 Juin 2021

Bonjour @patricktoulon

patricktoulon à dit:
mais c'est pas parfait en base 0 j'ai encore des soucis

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.

patricktoulon · 19 Juin 2021

re
Bonjour laurent

dis moi avec ceci

VB:

  If (UBound(t, 1) > 1 And UBound(t, 2) = 1) Or (UBound(t, 1) = 1 And UBound(t, 2) > 1) Then

si le tableau injecté est d'une seul dim on fait quoi ?

Dudu2 · 19 Juin 2021

Toujours pas saisi à 100%

@Dudu2 non pas plage :1 colonne ou 1 ligne ou un array

- 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 ?

patricktoulon · 19 Juin 2021

Bonjour @Dudu2
non un array n'a qu'une dimension pour moi

patricktoulon · 19 Juin 2021

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

patricktoulon · 19 Juin 2021

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

soan · 19 Juin 2021

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

patricktoulon · 19 Juin 2021

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

patricktoulon · 19 Juin 2021

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

patricktoulon · 19 Juin 2021

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'

Dudu2 · 19 Juin 2021

@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

laurent950 · 19 Juin 2021

Bonjour @patricktoulon

patricktoulon à dit:
vous me direz ce que vous en pensez ( ou pas) comme vous le voulvoul'

Un souci VBA et PatTaTrack... Heureusement il y a PatStrick... qui après un peu d'entrainement arrive enfin à décrocher le Grand Prix de l'Excel-Lence ... Félicitation @patricktoulon

Laurent950

patricktoulon · 19 Juin 2021

re
Bonjour @Dudu2 j'avais essayé déjà avec l'ID on memory du type a mon avis c'est plus que 123 en conversion string pour les macro4
et vu le nombre devant le représenter je pense que 4 "J" ne sont pas suffisants

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

patricktoulon

XLDnaute Barbatruc

patricktoulon

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires