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

　暱稱: 豪

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

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-10-10 13:41 | 只看該作者

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

如何設定能將左方原始資料
1.同類別內同品名相同者且數量大於20的
.並且備註欄只有【.】的資料列刪除呢?

主要卡在不知該如何統計此出現次數大於20的項目做刪除

多條件判斷刪除.zip (12.72 KB)

樓主熱帖

hcm19522

大學生 Rank: 4

帖子: 1391
主題: 4
精華: 0
積分: 1401
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-12-16

熱烈參與勳章

2^#

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

http://blog.xuite.net/hcm19522/twblog/348638247

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

3^#

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

先將樞紐分析表內容貼至另一工作表!

Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range([B2], [B65536].End(xlUp))
'以ＢＣ欄值為KEY納入字典檔並累計次數　
For Each xR In xArea
　T = xR & xR(1, 2): xD(T) = xD(T) + 1
Next
'檢查符合刪除條件者，納入 xU 儲存格聯集　
Set xU = xArea(xArea.Count + 1)
For Each xR In xArea
　T = xR & xR(1, 2)
　If xD(T) >= 20 And xR(1, 3) = "." Then Set xU = Union(xU, xR)
Next
'刪除　
xU.EntireRow.Delete
End Sub

kingvincent

中學生 Rank: 2

帖子: 12
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 20
性別: 男
註冊時間: 2015-8-21
最後登錄: 2017-11-7

4^#

發表於 2015-10-25 21:59 | 只看該作者

真是受用，感謝分享!!

　暱稱: 豪

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

5^#

發表於 2015-11-3 22:55 | 只看該作者

回復 3# 准提部林

感謝~真是好用！可用在很多地方

　暱稱: 豪

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

6^#

發表於 2015-11-3 22:55 | 只看該作者

回復 2# hcm19522

謝謝～提供函數用法

　暱稱: 豪

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

7^#

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

回復 3# 准提部林
版大～不好意思　遇到個問題　
再刪除資料時可設定範圍嗎？　因同一活頁內有三張表格，目前此代碼會刪除整列導致另外兩張資料也一併刪除了

如像下列這種　只刪除篩選範圍內資料

With Sheets("數據(早餐)")
.Select
.Range("$A$1:AA5000").AutoFilter Field:=6, Criteria1:=Array( _
"紅茶", "奶茶", "0"), Operator:=xlFilterValues
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).ClearContents
.AutoFilter
End With
End With

複製代碼

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

8^#

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

回復 7# starry1314

請上傳檔案, 並模擬需求結果~~

　暱稱: 豪

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

9^#

發表於 2015-11-27 14:42 | 只看該作者

多條件判斷刪除.rar (16.02 KB) 回復 8# 准提部林

結果是跟以下代碼一樣的,只是說不要刪除整列只刪除指定範圍內的資料

Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range([B2], [B65536].End(xlUp))
'以ＢＣ欄值為KEY納入字典檔並累計次數　
For Each xR In xArea
　T = xR & xR(1, 2): xD(T) = xD(T) + 1
Next
'檢查符合刪除條件者，納入 xU 儲存格聯集　
Set xU = xArea(xArea.Count + 1)
For Each xR In xArea
　T = xR & xR(1, 2)
　If xD(T) >= 20 And xR(1, 3) = "." Then Set xU = Union(xU, xR)
Next
'刪除　
xU.EntireRow.Delete
End Sub

複製代碼

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

10^#

發表於 2015-11-27 18:06 | 只看該作者

回復 9# starry1314

Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$, i&
For i = 1 To 9 Step 4
　　Set xD = CreateObject("Scripting.Dictionary")
　　Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 4))
　　For Each xR In xArea
　　　　T = xR(1, 2) & xR(1, 3): xD(T) = xD(T) + 1
　　Next
　
　　Set xU = Cells(xArea.Rows.Count + 2, 1)
　　For Each xR In xArea
　　　　T = xR(1, 2) & xR(1, 3)
　　　　If xD(T) >= 20 And xR(1, 4) = "." Then Set xU = Union(xU, xR.Resize(1, 4))
　　Next
　
　　If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next i
End Sub