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

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

XLDnaute Barbatruc
@patricktoulon,

Si je peux me permettre d'interférer dans vos savants échanges.
oui mais ca fait un peu usine a gaz
Si aller chercher des NET Frameworks et des DLL de l'espace c'est moins "usine à gaz" alors OK.
alors que j'ai seulement besoins de savoir si c'est un array, une ligne ou une colonne
Un Array on le chope par le VarType.
Une ligne et une colonne je vois pas ce que tu veux dire. En terme de tableau ça se traduit par quoi dans ta recherche ?
 

patricktoulon

XLDnaute Barbatruc
re
re
Dudu2
je veux la meme chose que ça avec une autre méthode qui n'utiliserait pas de gestion d'erreur
VB:
Sub testy7()    'test tableau ligne ligne renvoie 11 ou 14( pas bon )
    Dim liste
    a = [A1:z1].Value
    MsgBox WhatIsIt(a)
    ReDim liste(1, 0 To 5)
    MsgBox WhatIsIt(liste)
    ReDim liste(0, 1 To 5)
    MsgBox WhatIsIt(liste)
    ReDim liste(1 To 1, 1 To 5)
    MsgBox WhatIsIt(liste)
End Sub

Sub testy3()    ' test tableau colonne renvoi 14
    Dim liste As Variant
    liste = [A1:A10].Value
    MsgBox WhatIsIt(liste)
    ReDim liste(0 To 5, 1 To 1)
    MsgBox WhatIsIt(liste)
    ReDim liste(0 To 5, 0)
    MsgBox WhatIsIt(liste)
End Sub

Sub testy1()    'test array renvoie 3
    Dim liste As Variant
    liste = Array(1, 2, 3, 4, 5, 6)
    MsgBox WhatIsIt(liste)
    ReDim liste(1 To 10)
    MsgBox WhatIsIt(liste)
MsgBox WhatIsIt(Split("toto,toto,titi,riri,fifi", ","))

End Sub

Function WhatIsIt(ByVal quoi As Variant)
    On Error Resume Next
    x = UBound(quoi, 2):
    If Err.Number > 0 Then WhatIsIt = "array": Err.Clear: Exit Function
    If UBound(quoi) > 0 Then WhatIsIt = "colonne"
    ind = IIf(UBound(quoi, 2) = 0, 1, UBound(quoi, 2))
    WhatIsIt = IIf(ind >= 2, "ligne", "colonne")
    Err.Clear
End Function
 

dysorthographie

XLDnaute Accro
bonjour Dudu2,
dans vba TypeName(tableau) retoune Varant()!
dans VB.net TypeName(tableau) retoune Object(,,,,,,,), ce qui permet de faire un split(",")
VB:
For i As Integer = 1 To TypeName(T).ToString.Split(",").Count
    If vReturn <> "" Then vReturn += ","
    vReturn += UBound(T, i).ToString
Next
voila le résulta dans dégug
RD|Range("A1:C2")|Object(2,3)|String(1,2,3)|Integer(1,20,3)|Object(1)|Nothing|String|Object(10,5,6)
j'imagine que Patrick souhaite un résultat proche de ça!
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
@patricktoulon (salut Dudu2)

Image 1.jpg


tu m'as mis un doute ! 😂 ma dernière mise à jour de Windows était le 5 juin 2021 ; j'viens d'relancer Windows Update ; ça ne m'a pas proposé de mise à jour facultative, seulement ces 2 importantes :

Image 2.jpg



je les ai installées toutes les deux :​

Image 3.jpg




ce que je peux vérifier aussi ici :

Image 4.jpg




par précaution, j'ai de nouveau relancé Windows Update, car c'est comme pour les trains : « un train peut en cacher un autre » ; autrement dit : ça peut arriver qu'après une mise à jour, ça en propose d'autres ; surtout si y'a un effet « boule de neige » qui fait qu'une mise à jour récente d'un logiciel attend qu'une autre mise à jour antérieure de ce même logiciel attend qu'elle ait été installée pour être proposée ; parfois aussi, une mise à jour récente de Net Framework (ou d'un autre logiciel) peut attendre qu'une mise à jour récente de Windows soit d'abord installée avant d'être proposée.​

Image 5.jpg




et tant qu'à faire, vu c'qui vient d'être installé, j'en ai profité :

Image 6.jpg


comme on dit : « ça mange pas d'pain », hein ? 😜

Image 7.jpg

soan
 

patricktoulon

XLDnaute Barbatruc
re
@soan tu n' a rien compris de ce que je t'ai dis
pour te la faire courte
si tu a installé une app (par exemple l'année dernière ) utilisant une version inférieure du framework

ben...... walouh !! si l’éditeur de ton app ne fait pas la mise a jour ton app sera morte et enterrée
alors oui je suis désolé ;non seulement ça mange du pain mais ça t'enlève le saucisson
 

soan

XLDnaute Barbatruc
Inactif
non seulement ça mange du pain mais ça t'enlève le saucisson

LOLLLL ! 🤣 j'connaissais pas cette expression ! elle existe pour de bon ? ou c'est toi qui vient d'l'inventer ? en tout cas, tu m'donnes faim, avec ton saucisson ! 🌭 😋 surtout qu'il est bien plus d'midi, et qu'j'ai pas encore eu l'temps d'manger ! 😭

mais à propos de c'que tu dis pour d'anciennes applications qui ne marcheraient plus avec une version récente de Net Framework, car sauf mise à jour de leur éditeur, il leur faut toujours une ancienne version de Net Framework, j'ai la chance de ne pas être dans ce cas-là : j'ai pas d'anciens logiciels ; à part Windows 7, Office 2007, TuneUp Utilities 2007, et quelques autres qui marchent sans aucun problème avec ma version récente de Net Framework 5.8 ! 😊

par rapport à ton post #82 : bonne chance avec ton ancienne version de Net Framework 4.7.2 (chez toi) et 3.5 (au bureau) ! 🍀 comme disait le lapin dans "Alice au pays des merveilles" : je te souhaite un non-anniversaire une non-installation de Net Framework 4.8 ! :) fallait le faire, hein, de mettre une citation très judicieuse d'Alice au pays des merveilles dans le cadre d'une conversation sur l'informatique ! 😁 (nonobstant le post #83 de dysorthographie ! 😜)



edit : l'ancien post #83 de dysorthographie est devenu le post #86. (des fois, quand on surfe sur le web, il peut arriver qu'un post navigue un peu au hasard, au gré des vagues, et au fil de l'eau...)

soan
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
@patricktoulon,
je veux la meme chose que ça avec une autre méthode qui n'utiliserait pas de gestion d'erreur
Quelle coïncidence !! Avant que tu ne postes j'ai appelé ma fonction EXACTEMENT comme toi (WhatIsIt) ! J'en reste coi o_O

Je reviens avec mon "usine à gaz" (franchement y a pire) , et après, promis, je vous laisse tranquillous.
VB:
Option Explicit

'https://stackoverflow.com/questions/6901991/how-to-return-the-number-of-dimensions-of-a-variant-variable-passed-to-it-in-v
#If VBA7 Then
  Private Type Pointer: Value As LongPtr: End Type
  Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
  Private Type Pointer: Value As Long: End Type
  Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    sa As Pointer
End Type

Sub Test()
    Dim t As Variant
  
    t = Array(1, 2, 3)
    MsgBox WhatIsIt(t)
  
    t = [A1:A12].Value
    MsgBox WhatIsIt(t)
  
    t = [A1:L1].Value
    MsgBox WhatIsIt(t)
  
    t = [A1:L12].Value
    MsgBox WhatIsIt(t)
End Sub

Public Function GetDims(source As Variant) As Integer
    Dim va As TtagVARIANT
    RtlMoveMemory va, source, LenB(va)                                            ' read tagVARIANT              '
    If va.vt And &H2000 Then Else Exit Function                                   ' exit if not an array         '
    If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa)  ' read by reference            '
    If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2               ' read cDims from tagSAFEARRAY '
End Function

Public Function WhatIsIt(t As Variant) As String
    Select Case GetDims(t)
        Case 2
            If UBound(t, 1) - LBound(t, 1) = 0 Then
                WhatIsIt = "C'est un array issu d'un Range de ligne"
            ElseIf UBound(t, 2) - LBound(t, 2)  = 0 Then
                WhatIsIt = "C'est un array issu d'un Range de colonne"
            Else
                WhatIsIt = "C'est un array issu d'un Range de ligne(s) et colonne(s)"
            End If
      
        Case Else
            WhatIsIt = "C'est pas un array issu de Range"
    End Select
End Function
 
Dernière édition:

dysorthographie

XLDnaute Accro
par rapport à ton post #82 : bonne chance avec ton ancienne version de Net Framework 4.7.2 (chez toi) et 3.5 (au bureau)
Les versions framework s'empli pour éviter le plantage des anciennes version c'est exactement dan ce but que Microsoft la développer pour cloisonner les applications, a contrario du système 32

pour utiliser CreateObject("System.Collections.SortedList") il ma fallu installer Framework 3.5 alors que j'avais bien la 4.7.2 !

dans mon imprime écran il n'apparait pas et pourtant il est toujours installé!
 

patricktoulon

XLDnaute Barbatruc
re
@Dudu2
même isarray est inutile puisqu'il me retourne vrai pour toutes sortes de tableaux et array
pour les array et tableaux vertical et horizontal en base 1 j'ai bien trouvé une solution (quoi que pas bien au point) mais le base 0 ne rentre pas dans ce modèle
les api je ne les utilises quasiment plus sous cette forme je les utilises avec les macro4 (sans déclarations)
 

Dudu2

XLDnaute Barbatruc
@patricktoulon,
même isarray est inutile puisqu'il me retourne vrai pour toutes sortes de tableaux
Oui bien sûr. C'était juste pour revenir sur le VarType non utilisable pour Variant initialement pour répondre à la question Array sans plus de précision.
les api je ne les utilises quasiment plus sous cette forme je les utilises avec les macro4 (sans déclarations)
Je sais j'ai vu ton code y faire référence. Je ferai appel à toi lorsque j'en aurai besoin ;)
 

Dudu2

XLDnaute Barbatruc
les api je ne les utilises quasiment plus sous cette forme je les utilises avec les macro4 (sans déclarations)
D'ailleurs tu peux peut-être libérer la fonction GetDims() ci-dessus des fonctions APIs.
Pour réduire les tuyaux de "l'usine à gaz". :)

Moi je n'y arrive pas malgré différents essais:
- Je ne comprends rien au 3ème paramètre ("JJJJ" ou "JJCC" ou toutes autres lettres)
- Je ne sais pas comment passer des arguments qui ne sont pas des valeurs (2 , "chaine", etc..) comme des ByRef de zone (via ValPtr() ?).
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Hello @patricktoulon,

Je ne sais pas si tu as pu voir ma demande d'ExecuteExcel4Macro'ifier cette fonction qui contient la fonction API RtlMoveMemory (copie mémoire) ou si tu y a renoncé car pas possible.
En tous cas j'aimerais bien avoir ton retour sur cette option car je n'ai pas réussi à le faire.

VB:
Option Explicit

'https://stackoverflow.com/questions/6901991/how-to-return-the-number-of-dimensions-of-a-variant-variable-passed-to-it-in-v

#If VBA7 Then
  Private Type Pointer: Value As LongPtr: End Type
  Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
  Private Type Pointer: Value As Long: End Type
  Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    sa As Pointer
End Type

Public Function GetDims(source As Variant) As Integer
    Dim va As TtagVARIANT
    
    RtlMoveMemory va, source, LenB(va)                                            ' read tagVARIANT              '
    If va.vt And &H2000 Then Else Exit Function                                   ' exit if not an array         '
    If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa)  ' read by reference            '
    If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2               ' read cDims from tagSAFEARRAY '
End Function
 

Discussions similaires

Réponses
4
Affichages
456

Membres actuellement en ligne

Statistiques des forums

Discussions
315 147
Messages
2 116 770
Membres
112 857
dernier inscrit
sanogo