VBA scripting.dictionary檢查字典內容日期或數字或字母數字？

Question

我只是使用來自不同列的字典創建獨特項目列表並將它們饋送到組合框中。我想知道是否有方法檢查字典是否僅包含數字值或字母數字，因爲某些列只包含數字，而其他字段僅包含文本和日期。

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 

我還有一個問題。我想循環這個並創建每列的唯一列表並將其存儲在k1，k2，k3 ...等等。我該怎麼做呢？

謝謝。

Answer 1

試試這個

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

更新對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 

測試

Answer 2

使用詞典的詞典：

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 

---