Question

我正在从g（对象）中提取键值，但它们在M范围内相互覆盖，我不明白，因为它应该寻找偏移？我显然遗漏了一些东西。有任何想法吗？谢谢！

With wbkVer.Worksheets(1)
    Set g = CreateObject("scripting.dictionary")   
    Set rngChasssSrc = wbkCS.Worksheets(2).Range("Z3:Z20")
    Set rngchassis = wbkVer.Worksheets(1).Range("M" & .Rows.Count).End(xlUp).Offset(1, 0)
For Each k In rngChasssSrc
    tmp = Trim(Right(k.Value, 7))
    If Not IsEmpty(tmp) Then g(tmp) = g(tmp) + 1
Next k
For Each u In g.Keys()
    rngchassis.Value = u
Next u
End With

最终代码：

With wbkVer.Worksheets(1)
    Set g = CreateObject("scripting.dictionary")
    Set rngChasssSrc = wbkCS.Worksheets(2).Range("Z3:Z20")
    Set rngchassis = .Range("M" & .Rows.Count).End(xlUp).Offset(1, 0)

    For Each k In rngChasssSrc
        If k > 0 then
        tmp = Trim(Right(k.Value, 7))
        If Not IsEmpty(tmp) Then g(tmp) = g(tmp) + 1
        End if
    Next k
    For Each u In g.Keys()
        rngchassis.Value = u
        Set rngchassis = .Range("M" & .Rows.Count).End(xlUp).Offset(1, 0)
    Next u
End With

Answer 1

rngchassis.Value = u

问题是你没有递增目标单元格，因此它会一直覆盖它：）

未经测试 - 这是您正在尝试的吗？

Option Explicit

Sub Sample()
    Dim lRow As Long

    With wbkVer.Worksheets(1)
        Set g = CreateObject("scripting.dictionary")
        Set rngChasssSrc = wbkCS.Worksheets(2).Range("Z3:Z20")

        '~~> Find Last Row in Col M for writing
        lRow = .Range("M" & .Rows.Count).End(xlUp).Row + 1

        For Each k In rngChasssSrc
            tmp = Trim(Right(k.Value, 7))
            If Not IsEmpty(tmp) Then g(tmp) = g(tmp) + 1
        Next k
        For Each u In g.Keys()
            .Range("M" & lRow).Value = u
            lRow = lRow + 1
        Next u
    End With
End Sub

修改

BTW，您的上述代码也可以写成（注意重置范围）

With wbkVer.Worksheets(1) Set g = CreateObject("scripting.dictionary") Set rngChasssSrc = wbkCS.Worksheets(2).Range("Z3:Z20") Set rngchassis = .Range("M" & .Rows.Count).End(xlUp).Offset(1, 0) For Each k In rngChasssSrc tmp = Trim(Right(k.Value, 7)) If Not IsEmpty(tmp) Then g(tmp) = g(tmp) + 1 Next k For Each u In g.Keys() rngchassis.Value = u Set rngchassis = .Range("M" & .Rows.Count).End(xlUp).Offset(1, 0) Next u End With

Answer 2

For Each u ...循环可以替换为

rngchassis.Resize(g.Count, 1) = Application.Transpose(g.Keys)

将scripting.dictionary中的键值提取到范围中

2 个答案: