2015-10-03 2 views
1

Я просто создаю список уникальных предметов, используя словарь из разных столбцов и подавая их в комбинированные поля. Я хотел бы знать, есть ли способ проверить, содержит ли словарь только числовые значения или буквенно-числовые, поскольку некоторые столбцы содержат только числа, а другие содержат текст и даты.VBA scripting.dictionary проверяет даты словаря или числовые или буквенные числа?

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 ... и так далее. Как мне это сделать?

Спасибо.

enter image description here

ответ

0

попробовать это

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

тест

enter image description here

+0

благодаря .И будет попробовать. У меня есть еще один вопрос. Я хотел бы создать цикл и создать уникальный список каждого столбца и сохранить его в k1, k2, k3 ... и так далее. Как мне это сделать? – Shan

+0

не могли бы вы предоставить образец данных (подделка), я покажу вам путь – Vasily

+0

Добавлен поддельный снимок экрана .. – Shan

0

Использование словаря словарей:

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 

enter image description here

Смежные вопросы