請問如何可統計出現次數並且包含多條件的資料刪除呢? - Excel程式區

返回列表下一主題上一主題發帖

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

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

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

11^# 跳轉到 »

發表於 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