将单独的列添加到字典中



我正在尝试将拆分范围(X5:X?,AX5:AX?(中的数据添加到VBA字典中。确定为工作表中的最后一行数据。我是 VBA 的新手,并试图强行解决这个问题。

Public Sub Test
'Creates a dictionary object
 Dim orderstatus As Object, path As String
 Set orderstatus = CreateObject("Scripting.Dictionary")
 Dim order, status 'key and object names
 order = "Order #": status = "Order Status"
 path = ThisWorkbook.path
'Central District--A Head Water Order Summary
 Dim app As New Excel.Application, book As Excel.Workbook
 app.Visible = False
 Set book = app.Workbooks.Add(path & "CENTRAL DISTA HEAD - WATER ORDER SUMMARY.xls")

'A Head #1
 Dim A1Head As Integer, last As Integer, l as Integer
 l = 4
 book.Worksheets("A HEAD #1").Activate
 last = Range("X" & Rows.Count).End(xlUp).Row
 Set lastCol = Range("X5:X" & last, "AX5:AX" & last)
 For Each l In lastCol.Cells
    orderstatus.Add lastCol.Value
 Next
End Sub

任何帮助将不胜感激!

我认为这样的东西就是你要找的:

Sub tgr()
    Dim OrderStatus As Object
    Dim i As Long
    Dim Key As Variant
    Set OrderStatus = CreateObject("Scripting.Dictionary")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    With Workbooks.Open(ThisWorkbook.Path & "CENTRAL DISTA HEAD - WATER ORDER SUMMARY.xls").Sheets("A HEAD #1")
        For i = 5 To .Cells(.Rows.Count, "X").End(xlUp).Row
            If Not OrderStatus.Exists(.Cells(i, "X").Value) Then OrderStatus(.Cells(i, "X").Value) = .Cells(i, "AX").Value
        Next i
        .Parent.Close False
    End With
    'Print dictionary to text file
    Close #1
    Open ThisWorkbook.Path & "OrderStatus Output.txt" For Output As #1
    Print #1, "Key" & vbTab & "Value"
    For Each Key In OrderStatus.Keys
        Print #1, Key & vbTab & OrderStatus(Key)
    Next Key
    Close #1
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

更改此内容

orderstatus.Add lastCol.Value

对此

orderstatus.Add l.Value, 1

这假设您不会有重复项,因为您没有检查它,并且如果您有重复项,则会收到错误。

你弄乱了Range对象和Row索引

您最好放弃Activate/ActiveXXX模式并使用完全限定的范围引用

试试这段代码

Option Explicit
Public Sub Test()
    'Creates a dictionary object
    Dim orderstatus As Object
    Set orderstatus = CreateObject("Scripting.Dictionary")
    'Central District--A Head Water Order Summary
    Dim app As New Excel.Application, book As Excel.Workbook
    app.Visible = False
    Set book = app.Workbooks.Add(ThisWorkbook.path & "CENTRAL DISTA HEAD - WATER ORDER SUMMARY.xls")
    'A Head #1
    Dim dataRng As Range, r As Range
    Dim last As Integer
    With book.Worksheets("A HEAD #1")
        For Each r In .Range("X5", .Cells(.Rows.Count, "X").End(xlUp))
           orderstatus(r.value) = r.Offset(, 26).value
        Next
    End With
End Sub

此外,如果您已经在 Excel 会话中运行此宏,则无需获取它的另一个实例,也无需显式引用它:

Option Explicit
Public Sub Test()
    'Creates a dictionary object
    Dim orderstatus As Object
    Set orderstatus = CreateObject("Scripting.Dictionary")
    'Central District--A Head Water Order Summary
    Dim book As Workbook
    Set book = Workbooks.Add(ThisWorkbook.path & "CENTRAL DISTA HEAD - WATER ORDER SUMMARY.xls")
    'A Head #1
    Dim dataRng As Range, r As Range
    Dim last As Integer
    With book.Worksheets("A HEAD #1")
        For Each r In .Range("X5", .Cells(.Rows.Count, "X").End(xlUp))
           orderstatus(r.value) = r.Offset(, 26).value
        Next
    End With
End Sub

最新更新