从scripting.dictionary中提取键值到一个范围
我从g（object）很好的提取键值，但他们覆盖在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
rngchassis.Value = u
问题是，你不增加目标单元格，因此它一直覆盖它:)
未经testing – 这是你正在尝试？
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
编辑
顺便说一句，你的上面的代码也可以写成（注意重置范围）
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
For Each u ...循环可以replace为
rngchassis.Resize(g.Count, 1) = Application.Transpose(g.Keys)