[發問] 請問如何可統計出現次數並且包含多條件的資料刪除呢?

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

21^#

發表於 2016-8-19 10:48 | 只看該作者

回復 20# 准提部林

感謝版大....我想的好複雜....

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

20^#

發表於 2016-8-19 10:10 | 只看該作者

For Each xR In xArea
　　If xR(1, 10) = "A" Then
　　　T = xR(1, 5) & xR(1, 6)
　　　xD(T) = xD(T) + 1
　　End If
Next

非"A"時，不要處理即可！

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

19^#

發表於 2016-8-18 14:30 | 只看該作者

回復 17# starry1314

目前的解決方式:將單位代號不屬於A的編號改為統一的編號再來做運算

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

18^#

發表於 2016-8-18 11:36 | 只看該作者

回復 16# 准提部林

大大不好意思
又遇到難題了......
底下為各類別的單一品項達20以上即刪除,且單位代號為A的則刪除部分欄位資料
貼紙條件=20
xR(1, 10)=單位代號

目前的難題是...達20以上的數量計算不包含單位代號不為A
不為A的單位則統一計算
有試著做修改但這樣因為單位代號滿多
T = xR(1, 5) & xR(1, 6) 改為↓
T = xR(1, 5) & xR(1, 6) & xR(1, 10)

Sub 條件刪除()
Dim arr, U%
Dim xArea As Range, xR As Range, xU As Range, xD, T$, I&
'For i = 1 To 28 Step 9
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 10
'自動偵測欄位數以9欄為一組
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range(Cells(2, I), Cells(Rows.Count, I).End(xlUp))
For Each xR In xArea
T = xR(1, 5) & xR(1, 6): xD(T) = xD(T) + 1
Next
'檢查符合刪除條件者，納入 xU 儲存格聯集
Set xU = Cells(xArea.Rows.Count + 2, 1)
For Each xR In xArea
T = xR(1, 5) & xR(1, 6)
If xD(T) >= [貼紙條件] And xR(1, 8) = "." And xR(1, 10) = "A" Then Set xU = Union(xU, xR.Resize(1, 3))
Next
'刪除
If xU.Count > 1 Then xU = "" 'xU.Delete Shift:=xlUp
'If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next I
End Sub

複製代碼

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

17^#

發表於 2015-11-28 14:01 | 只看該作者

回復 16# 准提部林
了解！感謝指導～!!

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

16^#

發表於 2015-11-28 13:33 | 只看該作者

回復 15# starry1314

間隔４跳三次，１－５－９，再跳一次就１３，所以 1 To 9 或 1 To 12 同樣～～

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

15^#

發表於 2015-11-28 13:19 | 只看該作者

回復 14# 准提部林

感謝~完美達到所要的效果 !!
自動偵測欄位好用多了,
不過不懂為何第一次PO的版本
For i = 1 To 9 Step 4 '共有12個欄位但不知為何會是9,不是應該是12嗎

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

14^#

發表於 2015-11-28 10:47 | 只看該作者

本帖最後由准提部林於 2015-11-28 10:57 編輯

回復 13# starry1314

Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)~~(1, 8)~~)　　

紅色部份請刪掉（一時筆誤．沒發現）！
取一個欄位即可，多了紅色部份，xArea就變成８個欄區～～

其它大致ｏｋ，就只看資料是否有固定架構，不然也是難以正確執行程式的！

下一行可自動偵測〔欄位〕數：
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 9

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

13^#

發表於 2015-11-28 10:10 | 只看該作者

回復 10# 准提部林
目前改為這樣可達成效果,不知是否有不妥的地方
Sub 標籤()
Dim xArea As Range, xR As Range, xU As Range, xD, T$, i&
For i = 1 To 28 Step 9
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 8))
For Each xR In xArea
      T = xR(1, 5) & xR(1, 6): xD(T) = xD(T) + 1
Next

Set xU = Cells(xArea.Rows.Count + 2, 1)
For Each xR In xArea
      T = xR(1, 5) & xR(1, 6)
      If xD(T) >= 20 And xR(1, 8) = "." Then Set xU = Union(xU, xR.Resize(1, 9))
Next

If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next i
End Sub