帖子: 10
主題: 3
精華: 0
積分: 62
點名: 0
作業系統: windowxp
軟體版本: SP3
閱讀權限: 20
註冊時間: 2011-3-31
最後登錄: 2020-1-12

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-12-18 12:13 | 只看該作者

[發問] 重複資料，如何使用VBA方式，指定特定字串製作成清單(已解決)

本帖最後由 totes 於 2011-12-18 20:56 編輯

需求為使用VBA方式，將DPARTNO欄位，指定TC字串開頭項目，製作成清單方式
1.結果如G6~G9範例 (只需TC開頭項目)
2.最終需求如G11自作成下拉選單

因另有其他用途，除樞紐分析以外，以上敘述有沒有辦法用VBA方式表達(第1點即可)
感謝了

重複資料，如何使用VBA方式，指定特定字串製作成清單.rar (62.08 KB)

樓主熱帖

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2011-12-18 22:52 | 只看該作者

回復 5# totes
不須使用範圍作清單

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
C = InputBox("輸入開頭字元", , "TC")
ar = Range("E2", [E65536].End(xlUp)).Value
For Each a In ar
If a Like C & "*" Then d(a) = "" '不重複符合規則
Next
If d.Count = 0 Then MsgBox "無符合資料": Exit Sub
With Range("G11").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.keys, ",")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

totes

中學生 Rank: 2

帖子: 10
主題: 3
精華: 0
積分: 62
點名: 0
作業系統: windowxp
軟體版本: SP3
閱讀權限: 20
註冊時間: 2011-3-31
最後登錄: 2020-1-12

5^#

發表於 2011-12-18 19:06 | 只看該作者

感謝版主，連下拉選單都有了，厲害!

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2011-12-18 18:35 | 只看該作者

回復 1# totes

Option Explicit
Sub Ex()
Dim S As String, I As Integer, W As String
S = ""
I = 2
[G:G] = ""
Do While Cells(I, 5) <> ""
W = Trim(Cells(I, 5))
If W Like "TC*" And InStr(S, W & ",") = 0 Then
S = S & W & ","
End If
I = I + 1
Loop
If S <> "" Then
S = Mid(S, 1, Len(S) - 1)
'1.結果如G6~G9範例 (只需TC開頭項目)
[G1].Resize(UBound(Split(S, ",")) + 1) = Application.Transpose(Split(S, ","))
'2.最終需求如G11自作成下拉選單
With [G11].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=S
End With
End If
End Sub

複製代碼

TOP

totes

中學生 Rank: 2

帖子: 10
主題: 3
精華: 0
積分: 62
點名: 0
作業系統: windowxp
軟體版本: SP3
閱讀權限: 20
註冊時間: 2011-3-31
最後登錄: 2020-1-12

3^#

發表於 2011-12-18 16:20 | 只看該作者

可以使用，真的感謝萬分^ ^

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2011-12-18 13:33 | 只看該作者

回復 1# totes
初學者VBA

Sub xx()
Range("G:G") = ""
I = 2
X = 1
Do While Cells(I, 5) <> ""
If (Cells(I, 5) Like "TC*") And (Range("G:G").Find(WHAT:=Cells(I, 5)) Is Nothing) Then
Cells(X, 7) = Cells(I, 5)
X = X + 1
End If
I = I + 1
Loop
End Sub

複製代碼

重複資料，如何使用VBA方式，指定特定字串製作成清單.zip (92.93 KB)

TOP