Contrôle de type de données dans Excel

[Spirolini]

Bonjour,

je souhaite procéder à un contrôle de type de données dans un tableau Excel.

je pensais utiliser "VarType" ou "TypeName".

Cela pose un problème car quand un utilisateur tappe un chiffre entier (exemple 132), VBA me retourne le type "Double" au lieu de Int.

Je balaie donc ma colonne avec un boucle
(exemple : for i=1 to Lignes / if cells(i,1)=...)
Je fais un test pour chaque cellule pour savoir si ma valeur est entière ou pas.

Le problème est que ceci prend trop de temps de traitement.

J'ai essayé de copié la plage de cellule (la colonne) directement dans un tableau en me disant que si une valeur n'est pas de type Integer, une erreur est retournée. Seulement VBA ne veux pas copier la plage dans un tableau de type Integer :

Cela ne fonctionne pas :
Dim Col_01() As Integer
Col_01 = Range(Cells(2, 1), Cells(NbLignes, 1)).Value

Ça fonctionne avec :
Dim Col_01() As Integer
Mais alors je perds mon contrôle de type...

Si vous avez une idée sur comment contrôler rapidement le type de données d'une colonne.

J'ai consigné dans une feuille annexe du classeur, le type des données attendue pour chaque colonne :
Colonne 1: Integer
Colonne 2: String
Colonne 3: Date
Col...

 

[MichD]

Re : Contrôle de type de données dans Excel

Bonjour,

Voici une fonction personnalisée qui distingue ces 5 types de données dans une cellule de la feuille de calcul.
String, Date, Integer, Long, Double

A ) Ceci s'adresse aux valeurs contenues dans les cellules de la feuille de calcul

Si cela te tente, tu peux en ajouter d'autres, ce n'est qu'un petit exemple.

Dans la cellule, tu écris : =TypeMyVa(A1) A1 étant la valeur dont tu veux trouver le type.

Function TypeMyVar(MyVar As Range)
Dim T As Variant, A As Integer, R As Long
T = MyVar.Value
If IsDate(T) Then
    TypeMyVar = "Date"
ElseIf Not IsNumeric(T) Then
    TypeMyVar = "String"
ElseIf A = 0 Then
    A = InStr(1, CStr(T), ",", vbTextCompare)
    If A > 0 Then R = Right(CStr(T), Len(CStr(T)) - A)
    If R = 0 Then
        If T >= -32768 And T <= 32767 Then
            TypeMyVar = "Integer"
        ElseIf T >= -2147483648# And T <= 2147483647 Then
            TypeMyVar = "Long"
        End If
    Else
        TypeMyVar = "Double"
    End If
End If
End Function

B ) Pour les variables que l'on utilise en vba, il y a ceci:

Un petit exemple :
'-----------------------------
Sub Testfdfd()
Dim T As Variant
T = 25
MsgBox MyVarType(T)
T = 1256395.95
MsgBox MyVarType(T)
T = #6/29/2012# 'Format américain des dates
MsgBox MyVarType(T)
End Sub
'-----------------------------

Function MyVarType(X As Variant) As String
Select Case VarType(X)
    Case Is = vbArray
        MyVarType = "vbArray"
    Case Is = vbBoolean
        MyVarType = "vbBoolean"
    Case Is = vbByte
        MyVarTypeIs = "vbByte"
    Case Is = vbCurrency
        MyVarType = "vbCurrency"
    Case Is = vbDataObject
        MyVarType = "vbDataObject"
    Case Is = vbDate
        MyVarType = "vbDate"
    Case Is = vbDecimal
        MyVarType = "vbDecimal"
    Case Is = vbEmpty
        MyVarType = "vbEmpty"
    Case Is = vbError
        MyVarType = "vbError"
    Case Is = vbInteger
        MyVarType = "vbInteger"
    Case Is = vbLong
        MyVarType = "vbLong"
    Case Is = vbDouble
        MyVarType = "vbDouble"
    Case Is = vbNull
        MyVarType = "vbNull"
    Case Is = vbObject
        MyVarType = "vbObject"
    Case Is = vbSingle
        MyVarType = "vbSingle"
    Case Is = vbString
        MyVarType = "vbString"
    Case Is = vbUserDefinedType
        MyVarType = "vbUserDefinedType"
    Case Is = vbVariant
        MyVarType = "vbVariant"
End Select    
End Function

N.B. Cette dernière fonction ne travaille pas bien si on tente de passer le contenu d'une cellule.
D'où la première fonction!

 

[Spirolini]

Re : Contrôle de type de données dans Excel

[Résolu]

Aors après avoir galéré pas mal sur les paramètres internationaux (séparateur décimal et de groupe de milliers). J'ai eu des tas de comportement non désirés. Je voulais que si on attend un nombre, alors le contrôle comprenne le point ou la virgule comme séparateur décimal, pour tout transformer en virgule sans soucis avec les %age.. (donc comprend 12.12% , 12,12% , 12.12 , 12,12 ...). Je fais :

Columns(Colonne).TextToColumns Destination:=Cells(1, Colonne), DecimalSeparator:=","
Columns(Colonne).NumberFormat = FormatColonne
Columns(Colonne).TextToColumns Destination:=Cells(1, Colonne), DecimalSeparator:="."
Columns(Colonne).NumberFormat = FormatColonne

Voici le code final :

'transforme tout en valeur
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("A2").Select

For Colonne = 1 To NbColonnes
Columns(Colonne).TextToColumns Destination:=Cells(1, Colonne), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True, DecimalSeparator:=",", ThousandsSeparator:=" "
Sheets("DataTypes").Select
Type_a_Integrer = Cells(1 + Colonne, 2)
Donnee_Max = Cells(1 + Colonne, 3)
Sheets("Matrice").Select
Select Case Type_a_Integrer
Case "string"
'MsgBox ("string")
For Ligne = 4 To NbLignes
'test du type > AUCUN TEST CAR TOUT SE TRANSFORME EN STRING
'test du max
If (Len(CStr(Cells(Ligne, Colonne).Value)) > Donnee_Max) Then
Cells(Ligne, Colonne).Select
MsgBox ("Erreur Texte trop long" & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
Next Ligne
Case "int"
'MsgBox ("int")
Donnee_Max = 10 ^ Donnee_Max
'Range(Cells(4, Colonne), Cells(NbLignes, Colonne)).Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
For Ligne = 4 To NbLignes
'test du type
If (IsNumeric(Cells(Ligne, Colonne))) Or ((Cells(Ligne, Colonne)) = "") Then
If Int(Cells(Ligne, Colonne).Value) <> Cells(Ligne, Colonne).Value Then
Cells(Ligne, Colonne).Select
MsgBox ("Erreur 'Non-Entier' Détecté " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
Else
Cells(Ligne, Colonne).Select
MsgBox ("Erreur 'Non-Entier' Détecté " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
'test du max
If Cells(Ligne, Colonne).Value > (Donnee_Max) Then
Cells(Ligne, Colonne).Select
MsgBox ("Erreur Maximum autorisé dépassé " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
Next Ligne
Case "decimal"
'MsgBox ("decimal")
Entier_Max = 10 ^ Int(Donnee_Max)
Nb_Decimal = Int(Right(Donnee_Max, 1))
FormatColonne = "0." & Right("00000000000000", Nb_Decimal)
Columns(Colonne).TextToColumns Destination:=Cells(1, Colonne), DecimalSeparator:=","
Columns(Colonne).NumberFormat = FormatColonne
Columns(Colonne).TextToColumns Destination:=Cells(1, Colonne), DecimalSeparator:="."
Columns(Colonne).NumberFormat = FormatColonne
'Range(Cells(4, Colonne), Cells(NbLignes, Colonne)).Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
For Ligne = 4 To NbLignes
'test du type
If (Cells(Ligne, Colonne) = "") Then
Else
If (IsNumeric(Cells(Ligne, Colonne))) Then
'Cells(Ligne, Colonne).Select
'MsgBox (Cells(Ligne, Colonne).Value)
'MsgBox (Round(Cells(Ligne, Colonne).Value, Nb_Decimal))
Cells(Ligne, Colonne).Value = Round(Cells(Ligne, Colonne).Value, Nb_Decimal)
Else
Cells(Ligne, Colonne).Select
MsgBox ("Erreur 'Non-Décimal' Détecté " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
'test du max
If Int(Cells(Ligne, Colonne).Value) > (Entier_Max) Then
Cells(Ligne, Colonne).Select
MsgBox ("Erreur Maximum autorisé dépassé " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
End If
Next Ligne
Case "bit"
'MsgBox ("bit")
For Ligne = 4 To NbLignes
'test du type
If (Cells(Ligne, Colonne).Value <> 1) And (Cells(Ligne, Colonne).Value <> 0) And (Cells(Ligne, Colonne).Value <> "") Then
Cells(Ligne, Colonne).Select
MsgBox ("Erreur booléen (1 ou 0) attendu " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
Next Ligne
Case "date"
'MsgBox ("date")
For Ligne = 4 To NbLignes
If (Cells(Ligne, Colonne) = "") Then
Else
'test du type
If IsDate(Cells(Ligne, Colonne)) Then
Else
Cells(Ligne, Colonne).Select
MsgBox ("Erreur Format date attendu " & vbCr & "cellule ligne " & Ligne & " colonne " & Colonne)
Exit Sub
End If
End If
Next Ligne
Case Else
For Ligne = 4 To NbLignes
'si rien.. ?
Next Ligne
End Select
Next Colonne