VBA 脚本字典数字字段

如何解决VBA 脚本字典数字字段

首先，过去一年我一直在使用 VBA 来实现一些效率，但我对 VBA 仍然很陌生，因此我的脚本绝对没有我希望的那么干净。

我的问题： 我创建了一个表格，可以在其中包含/排除较大数据集中的不同值。这个表是用脚本字典制作的。数据集可以包含数值作为参数，应将其视为文本值。示例：“05”和“5”应被视为两个不同的值。脚本字典将这两个值保存为两个不同的值，但是当我对键使用 Application.Transpose 代码时，这些键被视为一个值（“5”）。 有没有办法将键粘贴为两个不同的值？我尝试在相关数据前添加一个“'”，但这没有出现在键中。

代码：

Dim d As Object,c As Variant,j As Long,lr As Long
Set d = CreateObject("Scripting.Dictionary")
Worksheets("DATASET").Activate
lr = Cells(Rows.Count,aCell.Column).End(xlUp).Row
c = Range(Cells(1,aCell.Column).Address(),Cells(lr,aCell.Column).Address())
For j = 1 To UBound(c,1)
  d(c(j,1)) = 1
Next j

Targetrange.Resize(d.Count) = Application.Transpose(d.keys)
End If

希望你们清楚这一点。

提前致谢。

解决方法

Option Explicit

Sub macro1()
    Dim ws As Worksheet,aCell As Range,TargetRange As Range
    Dim ar As Variant,lr As Long,j As Long,c As Integer
    
    Dim d As Object,key As String
    Set d = CreateObject("Scripting.Dictionary")

    Set ws = Worksheets("DATASET")
    With ws
        Set aCell = .Range("A1") ' change
        c = aCell.Column
        lr = .Cells(Rows.Count,c).End(xlUp).Row
        ar = .Cells(1,c).Resize(lr).Value2
    End With

    For j = 1 To UBound(ar)
        key = Trim(ar(j,1))
        If Len(key) > 0 Then
            d(key) = 1
        End If
    Next

    Set TargetRange = Sheet2.Range("A1") ' change
    With TargetRange.Resize(d.Count)
        .NumberFormat = "@" ' text
        .Value2 = Application.Transpose(d.keys)
    End With
    MsgBox d.Count & " keys in d"

End Sub

,

如果您的 Targetrange 具有数字格式 General，它会将字符串 05 视为数字并将其转换为 5。

因此，要么在添加值之前将数字格式更改为文本：

Targetrange.NumberFormat = "@"
Targetrange.Resize(d.Count) = Application.Transpose(d.keys)

或者在字典中每个条目之前添加一个 '：

d("'" & c(j,1)) = 1

---

题外话：

Range() 方法可以获取单元格并且不需要地址，因此您可以从中删除 .Address()

Range(Cells(1,aCell.Column).Address(),Cells(lr,aCell.Column).Address())

然后写

 Range(Cells(1,aCell.Column),aCell.Column))

甚至更短：

 Cells(1,aCell.Column).Resize(RowSize:=lr)

如果它不是从第 1 行而是第 n 行开始，那么它是

 Cells(n,aCell.Column).Resize(RowSize:=lr - (n - 1))