亚洲在线久爱草,狠狠天天香蕉网,天天搞日日干久草,伊人亚洲日本欧美

為了賬號安全,請及時綁定郵箱和手機立即綁定
已解決430363個問題,去搜搜看,總會有你想問的

從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 關注
  • 671 瀏覽
慕課專欄
更多

添加回答

舉報

0/150
提交
取消
微信客服

購課補貼
聯系客服咨詢優惠詳情

幫助反饋 APP下載

慕課網APP
您的移動學習伙伴

公眾號

掃描二維碼
關注慕課網微信公眾號