[字典物件]單一欄位的值與多個陣列比對後並分類至不同欄位
- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-26
|
本帖最後由 准提部林 於 2016-10-21 19:53 編輯
回復 10# greetingsfromtw
那是工作表〔事件〕觸發程式，按Alt + F11，對工作表物件按兩下
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xR As Range
With Target
If Intersect([J2:L8], .Cells) Is Nothing Then Exit Sub
If .Value = "" Then Exit Sub
Cancel = True
For Each xR In Range([A2], Cells(Rows.Count, 1).End(xlUp))
If InStr(UCase(xR), UCase(.Value)) > 0 Then
Cells(Rows.Count, "G").End(xlUp)(2) = xR
End If
Next
End With
End Sub |
|
|
|
|
|
|
|
- 帖子
- 45
- 主題
- 10
- 精華
- 0
- 積分
- 59
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-6
- 最後登錄
- 2019-6-22
|
12#
發表於 2016-10-21 19:53
| 只看該作者
回復 11# 准提部林
了解,有看到了,是寫在工作表內,不好意思,小弟再研究一下.感謝前輩提醒. |
|
|
|
|
|
|
|
- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
13#
發表於 2023-5-10 14:51
| 只看該作者
回復 9# 准提部林
謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案1,方案學習心得註解如下,請前輩再指導
執行前:
執行結果:
Sub ex()
[B2:E200].ClearContents
'↑清除結果欄舊資料
Set d = CreateObject("Scripting.Dictionary")
'↑令d變數是字典
Set Rng = Range("J1").CurrentRegion.SpecialCells(xlCellTypeConstants)
'↑令Rng變數是 [J1]串並聯儲存格擴展範圍的非空白格 ('比對陣列)
For Each a In Range([A2], [A2].End(xlDown))
'↑設逐項迴圈!令a變數是A欄裡的儲存格 ('原始資料迴圈)
For Each c In Rng
'↑設逐項迴圈!令c變數是Rng變數裡的儲存格
If InStr(UCase(a), UCase(c)) > 0 Then
'↑如果a變數儲存格值轉換成英文大寫的新字串後,
'裡面有包含 c變數儲存格值轉換成英文大寫的新字串
d(c.Column) = ""
'↑令以c變數欄位數當key,item是空字元,納入d字典裡
'('記住比對到陣列的欄位)
End If
Next
If d.Count > 0 Then
'↑如果d字典key數量>0 ?('表示原始資料比對成功)
For Each ky In d.keys
'↑設逐項迴圈!令ky是d字典裡的一個key
Cells(65536, ky - 8).End(xlUp).Offset(1, 0) = a
'↑令結果欄的第一個空白格是 a變數(儲存格值)
Next
d.RemoveAll
'↑清空d字典
Else
Cells(65536, "E").End(xlUp).Offset(1, 0) = a
'↑比對不成功!就將a變數(儲存格值)放在E欄第一個空白格
End If
Next
End Sub |
|
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
14#
發表於 2023-5-10 15:42
| 只看該作者
回復 9# 准提部林
謝謝前輩
後學藉此帖學習前輩方案2(不重複),方案學習心得註解如下,請前輩再指導
執行結果:
Sub U_Test()
Dim xR As Range, xD, Arr, Brr, Mx&, N%, G(1 To 4), DK
'↑宣告變數
[B2:E200].ClearContents
'↑清除結果欄舊資料
Arr = Range([A2], Cells(Rows.Count, 1).End(xlUp))
'↑令Arr變數是二維陣列,以A欄儲存格值(原始資料)帶入陣列裡
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是字典
For Each xR In [J2:L40]
'↑令設逐項迴圈!令xR是範圍儲存格裡的一格
If xR <> "" Then xD(UCase(xR)) = xR.Column - 9
'↑如果xR變數不是空的!就令其轉換為大寫英文當key,item是其欄數-9,
'納入xD字典裡('關鍵字依其欄位帶序號)
Next
ReDim Brr(1 To UBound(Arr), 1 To 4)
'↑宣告Brr變數是二維空陣列,縱向範圍同Arr,橫向從1 到4
For i = 1 To UBound(Arr)
'↑設順迴圈
N = 4
'↑令N變數是 4 ('預設序號為4,是用來放不符合的資料)
For Each DK In xD.keys
'↑設逐項迴圈!令DK是xD字典裡的一個key
If InStr(UCase(Arr(i, 1)), DK) Then N = xD(DK): Exit For
'↑如果原始資料轉換英文大寫的新字串裡有包含DK變數!
'就令N變數變更為 以DK變數查xD字典的item值('有符合,取出序號),
'取出序號後就結束迴圈,代表不重複使用 原始資料
Next
G(N) = G(N) + 1
'↑依序號不同, 各自在G這一維陣列裡 累計欄位的筆數
If G(N) > Mx Then Mx = G(N)
'↑取得最大筆數
Brr(G(N), N) = Arr(i, 1)
'↑按序號及筆數填入資料到陣列
Next i
[B2].Resize(Mx, 4) = Brr
'↑令從[B2]開始擴展有資料的列數4欄,以Brr陣列值帶入
End Sub |
|
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
發表於 2016-10-21 19:50
| 
