VBA scripting.dictionary vérifier si les dates du contenu du dictionnaire ou numérique ou alphanumérique?

Question

Je suis juste en train de créer une liste d'éléments uniques en utilisant le dictionnaire de différentes colonnes et en les alimentant dans une zone de liste déroulante. Je voudrais savoir s'il existe un moyen de vérifier si le dictionnaire ne contient que des valeurs numériques ou alphanumériques car certaines colonnes ne contiennent que des chiffres et d'autres contiennent du texte et des dates.

With Sheets("Database") 
cNr = WorksheetFunction.Match(fString, .Rows(1), 0) 

lRo = .Cells(Rows.Count, 1).End(xlUp).Row 
    Set d = CreateObject("scripting.dictionary") 
     For Each c In Range(.Cells(2, cNr), .Cells(lRo, cNr)) 
      If Len(c.Value) > 0 Then 
       If Not d.Exists(c.Value) Then d.Add c.Value, 1 
      End If 
     Next c 
    k = d.keys 
End With 

J'ai une autre question. Je voudrais boucler cela et créer une liste unique de chaque colonne et le stocker en k1, k2, k3 ... et ainsi de suite. Comment puis-je faire cela?

Merci.

Answer 1

essayer cette

'''your code 
Dim key As Variant 
For Each key In d 
    If Not IsNumeric(key) Then 
     MsgBox "dictionary has a text value!" 
     Exit Sub 
    End If 
Next key 
'''your code 

mis à jour par rapport aux exigences OP

Sub test() 
    Dim key As Variant, d As Object: Set d = CreateObject("Scripting.Dictionary") 
    d.comparemode = vbTextCompare 
    Dim c As Range, i As Range: Set i = Range([A2], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "C")) 
    For Each c In i 
     If c.Column = 1 Then 
      If Len(c.Value) > 0 Then 
       If Not d.Exists(c.Value) Then d.Add c.Value, c.Column 
      End If 
     Else 
      If Not IsNumeric(c.Value2) Then 
       If Not d.Exists(c.Value & " text") Then d.Add c.Value & " text", c.Column 
      Else 
       If Not d.Exists(c.Value) Then d.Add c.Value, c.Column 
      End If 
     End If 
    Next c 
    Debug.Print "field", "value" 
    For Each key In d 
     Debug.Print d(key), key 
    Next key 
End Sub 

Test

Answer 2

L'utilisation d'un dictionnaire de dictionnaires:

Option Explicit 

Public Sub setColumns() 
    Dim ws As Worksheet, r As Long, c As Long, lr As Long, lc As Long 
    Dim dCols As Object, dCol As Object, cType As String, cel As String 

    Set ws = Worksheets("Sheet1") 
    Set dCols = CreateObject("Scripting.Dictionary") 
    With ws 
     With .UsedRange 
      lr = .Row + .Rows.Count - 1 
      lc = .Column + .Columns.Count - 1 
     End With 
     For c = .UsedRange.Column To lc 
      Set dCol = CreateObject("Scripting.Dictionary") 
      For r = .UsedRange.Row + 1 To lr 
       If r = .UsedRange.Row + 1 Then 
        Select Case True 
         Case IsNumeric(.Cells(2, c)): cType = "Number" 
         Case IsDate(.Cells(2, c)):  cType = "Date" 
         Case Else:      cType = "Text" 
        End Select 
       End If 
       If Len(.Cells(r, c).Value) > 0 Then dCol(r) = .Cells(r, c).Value 
      Next 
      If dCol.Count > 1 Then 
       dCols(c & "type") = cType 
       Set dCols(c) = dCol 
      End If: Set dCol = Nothing 
     Next 
     For c = .UsedRange.Column To lc 
      .Cells(lr + c + 1, 1) = "Row" & c & ", Col" & c & " Type: " & dCols(c & "type") 
      .Cells(lr + c + 1, 2).Value = "Value: " & dCols(c)(c + 1) 
     Next 
    End With 
End Sub 

---