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

[patricktoulon]

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

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

 

[laurent950]

Re @Dudu2, @patricktoulon

cette page pour les variable tableau Beaucoup d'exemple : CopyMemory Function

CopyMemory Function-VBForums

Hi All. I'm not convinced this is quite the right place for me to post. But I put this question in an Excel forum and no-one replied, so hopefully someone here will be able to help me out. (By way of background, I've had to learn to use VBA as part of my job recently. I've therefore got...

www.vbforums.com

La syntax :

CopyMemory function (Windows)

docs.microsoft.com

Une page avec plein d'exemple API :

Declaring API functions for 64 bit Office (and Mac Office)

JKP Application Development Services, Microsoft Office Application Development

jkp-ads.com

 

[patricktoulon]

@laurent950
bon j'ai un peu cafouillé avec les commentaires qui ne sont pas tout a fait exacts
néanmoins vous l'avez compris je détermine bien même quand c'est implicite ( base(0/1) alors que dans mes précédentes versions non

voila sans outils autre que ceux qui sont dispo en vba
pour la correction
[Parentheses]
et en plus j'ai ajouter un test qui contredit catégoriquement ce qu'avance @job75( me semble t il) en disant que le resize est plus rapide que la plage elle meme complète
on voit bien que pour une colonne de 1000000 de lignes nous avons un leger décroché de temps qui est plus important avec le resize
[/Parentheses]

Dim q(1 To 1000000, 1 To 1)

Sub test0()    'tableau 1 colonne explicite base(1,1)
    MsgBox GetTypeArray(q)
End Sub
Sub testX0()    'tableau 1 colonne explicite base(1,1)
    Dim t
    t = [A1].Resize(1000000, 1).Value
    MsgBox GetTypeArray(t)
End Sub
Sub test1()    'tableau 1 colonne explicite base (1,1)
't = [A1:A1000000].Value
    MsgBox GetTypeArray(t)
End Sub

Sub test2()    'tableau 1 ligne explicites base(1,10)
    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()    'tableau 4 lignes implicites 2 colonnes implicites base(0,0)
    Dim t(0 To 3, 1)
    t(1, 0) = "titi"
    MsgBox GetTypeArray(t)
End Sub
Sub test6()    'tableu 4 lignes implicites  1 colonne explicite base (0,1)
    Dim t(0 To 3, 1 To 1)
    MsgBox GetTypeArray(t)
End Sub

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

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

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

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

Sub test11()    'tableau 3 lignes implicites et 4 colonnes explicite base(0,1)
    Dim t(2, 1 To 4)
    MsgBox GetTypeArray(t)
End Sub

les deux formes

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

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

 

[laurent950]

Re @patricktoulon

Merci pour ce magnifique code.

Laurent

 

[patricktoulon]

re
merci Laurent
magnifique je ne sais pas , mais (simple , à la portée de tous , fonctionnel) oui
je continuerais a travailler sur l'api ne serait ce que pour transpirer un peu avec @Dudu2

 

[laurent950]

Re @patricktoulon

Il y a quelque chose sur cette page qui est intéressant dans le mécanisme :
Utilisation de type de données LongPtr Data Types

Using LongPtr Data Types - MS-Access Tutorial

Before we update the Declare statement lets recall what got us into this situation: lack of an official pointer data type and the subsequent overloading of Long to be the unofficial pointer data type.

sourcedaddy.com

 

[Bernard_XLD]

Bonjour le fil, le forum

Salut Patrick , tu peux essayer cela.
Un test qui renvoie un boolean à true pour les Array 1 dimension, à false pour les 2 dimensions.

Bien cordialement, @+

Function WhatIsIt(ByVal a As Variant)
    If IsArray(a) Then
        If TypeName(a) = "Range" Then a = a.Value
        If Application.IsErr(Application.Index(a, UBound(a), 1)) Then
            WhatIsIt = "array 1 dimension (colonne) de " & UBound(a) + 1 - LBound(a) & " valeurs."
        Else
            WhatIsIt = "Array 2 dimensions, Colonnes : " & UBound(a, 2) + 1 - LBound(a, 2) & " ,Lignes : " & UBound(a, 1) + 1 - LBound(a, 1)
        End If
    Else
        If TypeName(a) = "Range" Then a = a.Value
        If TypeName(a) <> "Variant()" Then WhatIsIt = TypeName(a)
    End If
End Function

Sub testy01()
    Dim Liste As Variant
    Liste = Array(1, 2, 3, 4, 5, 6)
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy02()
    Dim Liste(1 To 50, 1 To 10) As Variant, Compteur%, Compteur2%
    For Compteur = 1 To 50
        For Compteur2 = 1 To 10
            Liste(Compteur, Compteur2) = Compteur * Compteur2
        Next Compteur2
    Next Compteur
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy03()
    Dim Liste As Variant
    Set Liste = [A1:A13]
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy04()
    Dim Liste As Variant
    Set Liste = [A1:H1]
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy05()
    Dim Liste As Variant
    Liste = "1,2,3,4,5,6,7,8,9"
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy06()
    Dim Liste As Variant
     Liste = 12.36
    MsgBox WhatIsIt(Liste)
End Sub
Sub testy07()
Dim a
a = [A1:H1].Value
MsgBox WhatIsIt(a)
End Sub
Sub testy08()
Dim a
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
MsgBox WhatIsIt(a)
End Sub
Sub testy09()
Dim a(0 To 5, 1)
  a(5, 0) = "toto "
MsgBox WhatIsIt(a)
End Sub
Sub testy10()
Dim a(0 To 5, 0)
  a(0, 0) = "toto1 "
  a(1, 0) = "toto2 "
  a(2, 0) = "toto3 "
  a(3, 0) = "toto4 "
  a(4, 0) = "toto5 "
  a(5, 0) = "toto6 "
MsgBox WhatIsIt(a)
End Sub
Sub testy11()
    Dim Liste As Variant
    Liste = Array("essai1", "essai2", "essai3", "essai4", "essai5", "essai6")
    MsgBox WhatIsIt(Liste)
End Sub

 

[patricktoulon]

re
Bonjour yeahou
c'est sensiblement la même chose pour le test 2 dim

moi:
x=TypeName(Application.Index(t, 2, 2))

toi:
x=Application.IsErr(Application.Index(a, UBound(a), 1))

cela dit dans mon esprit ma question portait sur le genre de tableau
1 dim ou 2 dim mais aussi si il y avait qu'une colonne ou qu'une ligne ou si c’était un array
et cela que ce soit en base 0 ou 1 , issu d'un range ou pas

ta formule de test error je n'y avait pas pensé
et le test avec ubound(a) pour la première dimension est très bien j'adopte

si j'avais juste voulue le type 1/2 dim
j'aurais juste fait ceci

Function GetTypeArray2(a)
With Application
If .IsErr(.Index(a, UBound(a), 1)) Then GetTypeArray2 = "1 dim" Else GetTypeArray2 = "2 dim"
End With
End Function

ou

Function GetTypeArray2(a)
With Application
If TypeName(.Index(a, UBound(a), 1)) = "Error" Then GetTypeArray2 = "1 dim" Else GetTypeArray2 = "2 dim"
End With
End Function

Sub test()
Dim t(10, 0)
MsgBox GetTypeArray2(t)
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
MsgBox GetTypeArray2(a)
End Sub

 

[mapomme]

Bonjour à tous ,

Dites moi donc @patricktoulon et @Yeahou , Il y a tromperie sur la marchandise.

D'un côté, on dit :

sans avoir a gérer des erreurs dans un sens ou dans l'autre

Et de l'autre côté, on renvoie subrepticement la gestion de l'erreur à un programme extérieur à VBA (en l'occurence ici Excel) pour traiter l'erreur.

Application.IsErr(Application.Index(a, UBound(a), 1))

Belle imposture et belle manipulation de l'auditoire

Je suis taquin ce matin...

 

[patricktoulon]

Bonjour Mapomme

nom mon but est de ne pas utiliser le "on error resume next" que j’exècre sauf cas de force majeure
l'erreur elle !! il y a est forcement 1 chance sur 2 pour qu'elle soit présente donc on peut pas y couper

et il est intéressant de voir comment on code avec une gestion d'erreur post et pre event error
vba ne gère visiblement que le post error en ouvrant une session dans le stack "on error..."
ici avec application l'erreur est un retour possible donc une valeur à traiter et non le traitement de l'erreur

moi ça me convient

Pffff .....jamais content celui là

 

[mapomme]

Pffff .....jamais content celui là

Je savais bien que j'allais finir par complètement te réveiller en ce dimanche matin... (c'était un peu mon intention )

Bonne journée Patrick

 

[patricktoulon]

je debout depuis 5 heure ce matin
j’étais sur la correction de la fonction niemeday
bonne journée a toi aussi

 

[Bernard_XLD]

Bonjour le fil, le forum

ici avec application l'erreur est un retour possible donc une valeur à traiter et non le traitement de l'erreur

Mapomme , je suis d'accord avec Patrick sur ce coup là !

et il est intéressant de voir comment on code avec une gestion d'erreur post et pre event error
vba ne gère visiblement que le post error en ouvrant une session dans le stack "on error..."

oui, cela faisait un moment que j'essayais d'utiliser ce principe d'erreur de référence pour zapper la gestion d'erreurs Vba dans certains cas, je n'ai même pas pensé au début à l'appliquer à ce problème et ça faisait au moins deux jours que je zappais le fil pour bosser sur la version 2 de ma fonction de tableau auto des jours fériés pour les amis Suisses et Belges, je n'avais même pas vu que tu avais trouvé une astuce avec index.
Content que ta """prise de tête""" m'ait permis de trouver une façon de faire pour utiliser IsErr pour ça. ça ouvre des perspectives certaines.
J'adore ce genre de casse tête quasi insoluble, on recommence quand tu veux !

Bonne journée,
Bien amicalement,
Bernard

 

[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

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 GetTypeArray(t)
    MsgBox GetTypeArray2(t)
    MsgBox GetTypeArray3(t)
End Sub

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

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

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

End Sub

Sub test5()    'tableau 4 lignes implicites 2 colonnes implicites base(0,0)
    Dim t(0 To 3, 1)
    t(1, 0) = "titi"
    MsgBox GetTypeArray(t)
    MsgBox GetTypeArray2(t)
    MsgBox GetTypeArray3(t)
End Sub

Sub test6()    'tableu 4 lignes implicites  1 colonne explicite base (0,1)
    Dim t(0 To 3, 1 To 1)
    MsgBox GetTypeArray(t)
    MsgBox GetTypeArray2(t)
    MsgBox GetTypeArray3(t)
End Sub

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

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

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

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

Sub test11()    'tableau 3 lignes implicites et 4 colonnes explicite base(0,1)
    Dim t(2, 1 To 4)
    MsgBox GetTypeArray(t)
    MsgBox GetTypeArray2(t)
    MsgBox GetTypeArray3(t)
End Sub

écriture 1

'version 1
Function GetTypeArray(t)
'modele Switch patricktoulon
    Dim Tx, x&, Z, x2, z2&
    z2 = UBound(t): If z2 = 0 Then x2 = Z + 1: x = x2 Else x = Z: x2 = x
    Z = Switch(z2 = 1, "ligne", TypeName(Application.Index(t, z2, 2)) <> "Error", "Tableau", x = x2, "Colonne", x < x2 Or x > 1, "array")
    If Z = "Colonne" And TypeName(Application.Index(t, z2, 1)) = "Error" Then Z = "array"
    GetTypeArray = Z
End Function

écriture 2

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

écriture 3

'version3
Function GetTypeArray3(t)
' avec la syntaxe de @yeahou pour index
    Dim Tx, x&, Z, x2
    Z = UBound(t): If LBound(t) = 0 Then x2 = UBound(t) + 1: x = x2 Else x = UBound(t): x2 = x
    With Application
        Select Case True
        Case x = 1: GetTypeArray3 = "ligne"    'si x= 1 c'est forcement une ligne (sauf array de 1 item)
        Case Not .IsErr(.Index(t, Z, 2)): GetTypeArray3 = "Tableau"
        Case Not .IsErr(.Index(t, Z, 1)): GetTypeArray3 = "Colonne"
        Case Else: GetTypeArray3 = "array"    'sinon c'est un array
        End Select
    End With
End Function

 

[Bernard_XLD]

re,

j'utilise typename par ce que je fait la même chose avec evaluate

Je n'avais jamais pensé à cette utilisation de typename et evaluate, ce genre de fil est pour moi la preuve qu'il faut s'intéresser aux prises de tête , c'est comme cela qu'on avance et c'est ce qu'on fait sur ce forum depuis sa création.

Bien cordialement, @

 

[patricktoulon]

re
ho ben avec moi tu es servi
je suis le roi de la question bien tordu que tout le monde fuit
plus c'est tordu plus j'aime