为了账号安全,请及时绑定邮箱和手机立即绑定

从Excel将唯一值填充到VBA数组中

从Excel将唯一值填充到VBA数组中

三国纷争 2019-11-19 11:03:28
谁能给我VBA代码,该代码将从Excel工作表获取一个范围(行或列),并用唯一值填充列表/数组,即:tabletablechairtablestoolstoolstoolchair当宏运行时会创建一个数组,例如:fur[0]=tablefur[1]=chairfur[2]=stool
查看完整描述

3 回答

?
呼啦一阵风

TA贡献1802条经验 获得超6个赞

在这种情况下,我总是使用这样的代码(只要确保您选择的分度数不在搜索范围内即可)


Dim tmp As String

Dim arr() As String


If Not Selection Is Nothing Then

   For Each cell In Selection

      If (cell <> "") And (InStr(tmp, cell) = 0) Then

        tmp = tmp & cell & "|"

      End If

   Next cell

End If


If Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)


arr = Split(tmp, "|")


查看完整回答
反对 回复 2019-11-19
?
阿晨1998

TA贡献2037条经验 获得超6个赞

Sub GetUniqueAndCount()


    Dim d As Object, c As Range, k, tmp As String


    Set d = CreateObject("scripting.dictionary")

    For Each c In Selection

        tmp = Trim(c.Value)

        If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1

    Next c


    For Each k In d.keys

        Debug.Print k, d(k)

    Next k


End Sub


查看完整回答
反对 回复 2019-11-19
?
拉风的咖菲猫

TA贡献1995条经验 获得超2个赞

将Tim的Dictionary方法与下面Jean-Francois的变量数组结合在一起。


您想要的阵列位于 objDict.keys


Sub A_Unique_B()

Dim X

Dim objDict As Object

Dim lngRow As Long


Set objDict = CreateObject("Scripting.Dictionary")

X = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp)))


For lngRow = 1 To UBound(X, 1)

    objDict(X(lngRow)) = 1

Next

Range("B1:B" & objDict.Count) = Application.Transpose(objDict.keys)

End Sub


查看完整回答
反对 回复 2019-11-19
  • 3 回答
  • 0 关注
  • 634 浏览
慕课专栏
更多

添加回答

举报

0/150
提交
取消
意见反馈 帮助中心 APP下载
官方微信