Question

我正在尝试编写一个基于单元格中的空格从单个文本单元格创建数组的代码。然后应该遍历每个数组值，看看它等效于哪个字典键值。

此后，代码转到工作表，根据活动单元格复制数据并粘贴到新的工作表中。一切正常，除了我也想将字典键和数据一起粘贴。我尝试为变量分配键值，并将范围设置为键值。

我已经测试过，如果我写：selection.value = 500，则将500输入到选择范围内。会喜欢任何帮助/指针。谢谢！

Sub Macro2()

'Keyboard Shortcut: Ctrl p

Dim dict As Object
Dim search As String
Dim i As Integer
Dim interval_array As Variant
Dim interval As String
Dim paste As Range

Set dict = CreateObject("scripting.dictionary")

dict.Add Key:=500, Item:=1
dict.Add Key:=800, Item:=2
dict.Add Key:=1000, Item:=3
dict.Add Key:=2000, Item:=4
dict.Add Key:=3000, Item:=5
dict.Add Key:=4000, Item:=6
dict.Add Key:=5000, Item:=7
dict.Add Key:=6000, Item:=8
dict.Add Key:=7000, Item:=9
dict.Add Key:=8000, Item:=10
dict.Add Key:=9000, Item:=11
dict.Add Key:=10000, Item:=12
dict.Add Key:=12000, Item:=13
dict.Add Key:=14000, Item:=14
dict.Add Key:=16000, Item:=15
dict.Add Key:=18000, Item:=16
dict.Add Key:=20000, Item:=17
dict.Add Key:=22000, Item:=18
dict.Add Key:=24000, Item:=19
dict.Add Key:=26000, Item:=20
dict.Add Key:=28000, Item:=21
dict.Add Key:=30000, Item:=22
dict.Add Key:=32000, Item:=23

search = ActiveCell.Value
interval_array = Split(search, " ")

ActiveCell.Offset(2).Select
Range(Selection, Selection.End(xlDown).End(xlToRight)).Select
Selection.Copy
Worksheets("data_table").Activate
ActiveSheet.paste
ActiveCell.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 2).Select

For Each word In interval_array
    For Each Key In dict
        'MsgBox (word)
        'MsgBox (key)
        If Key = word Then
            'interval = word.Value
             Selection.Value = word.Text
        Else
        End If
    Next
Next

End Sub

Answer 1

要在VBA中使用Dictionary对象功能：

要检查是否在interval_array对象中找到任何数组dict，可以使用：

If dict.exists(CLng(word)) Then
要从Item中检索dict，可以使用：

Selection.Value = dict(CLng(word))

如何从for循环变量分配单元格值

1 个答案: