返回列表 上一主題 發帖

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

totes

帖子
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)
收藏 分享

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
  1. Sub xx()

  3.     Range("G:G") = ""
  4.     I = 2
  5.     X = 1
  6.     Do While Cells(I, 5) <> ""
  7.        If (Cells(I, 5) Like "TC*") And (Range("G:G").Find(WHAT:=Cells(I, 5)) Is Nothing) Then
  8.           Cells(X, 7) = Cells(I, 5)
  9.           X = X + 1
  10.        End If
  11.        I = I + 1
  12.     Loop
  13.     End Sub
複製代碼
重複資料，如何使用VBA方式，指定特定字串製作成清單.zip (92.93 KB)

TOP

totes

帖子
10 
主題
3 
精華
0 
積分
62 
點名
0  
作業系統
windowxp 
軟體版本
SP3 
閱讀權限
20 
註冊時間
2011-3-31 
最後登錄
2020-1-12 
3#
發表於 2011-12-18 16:20 | 只看該作者
可以使用，真的感謝萬分^ ^

TOP

GBKEE

帖子
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
  1. Option Explicit
  2. Sub Ex()
  3.     Dim S As String, I As Integer, W As String
  4.     S = ""
  5.     I = 2
  6.     [G:G] = ""
  7.     Do While Cells(I, 5) <> ""
  8.         W = Trim(Cells(I, 5))
  9.        If W Like "TC*" And InStr(S, W & ",") = 0 Then
  10.           S = S & W & ","
  11.        End If
  12.        I = I + 1
  13.     Loop
  14.     If S <> "" Then
  15.         S = Mid(S, 1, Len(S) - 1)
  16.         '1.結果如G6~G9範例 (只需TC開頭項目)
  17.         [G1].Resize(UBound(Split(S, ",")) + 1) = Application.Transpose(Split(S, ","))
  18.         
  19.         '2.最終需求如G11自作成下拉選單
  20.         With [G11].Validation
  21.             .Delete
  22.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  23.             xlBetween, Formula1:=S
  24.         End With
  25.     End If
  26. End Sub
複製代碼

TOP

totes

帖子
10 
主題
3 
精華
0 
積分
62 
點名
0  
作業系統
windowxp 
軟體版本
SP3 
閱讀權限
20 
註冊時間
2011-3-31 
最後登錄
2020-1-12 
5#
發表於 2011-12-18 19:06 | 只看該作者
感謝版主，連下拉選單都有了，厲害!

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2011-12-18 22:52 | 只看該作者
回復 5# totes
不須使用範圍作清單
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. C = InputBox("輸入開頭字元", , "TC")
  4. ar = Range("E2", [E65536].End(xlUp)).Value
  5. For Each a In ar
  6.   If a Like C & "*" Then d(a) = ""  '不重複符合規則
  7. Next
  8. If d.Count = 0 Then MsgBox "無符合資料": Exit Sub
  9. With Range("G11").Validation
  10. .Delete
  11. .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  12.         xlBetween, Formula1:=Join(d.keys, ",")
  13.         .IgnoreBlank = True
  14.         .InCellDropdown = True
  15.         .InputTitle = ""
  16.         .ErrorTitle = ""
  17.         .InputMessage = ""
  18.         .ErrorMessage = ""
  19.         .IMEMode = xlIMEModeNoControl
  20.         .ShowInput = True
  21.         .ShowError = True
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 【行善要及時】行善要及時，功德要持續。如燒開水一般，未燒開之前千萬不要停熄火候，否則重來就太費事了。
返回列表 上一主題