excel vba 有條件的提取不重覆值求救!!

CK豬

CK豬
個人積分：8分
文章編號：78297436

8分

樓主

2020-07-12 12:14

excel明細如下：
excel vba 有條件的提取不重覆值求救!!

總表如下：

依年-月條件，提取不重覆值的進貨項目，寫進總表裡
小弟剛學習vba，只能試著google找了類似的程式，再試著加入年-月的條件讓他回傳，
但一直無法成功，程式碼如下，請教各位大大，條件年-月條件應該加到哪裡才適合呢?
Sub 取不重複值加條件()

Dim myList As New Collection, Cel As Range, itm, i As Integer

On Error Resume Next
For Each Cel In Sheets("資料明細").Range("b2:b999")
If Cel <> "" Then myList.Add Cel.Value, CStr(Cel.Value) '判斷單元格內容是否為空
Next

On Error GoTo 0
i = 3
For Each itm In myList
Sheets("總表").Cells(i, "a") = Format(itm, "@")
i = i + 1
Next

'資料回傳完成後做排序
Sheets("總表").Range("a3:a999").Select
Selection.Sort key1:=Range("a3"), order1:=1, Header:=x1yes

End Sub

2020-07-12 12:14 發佈

文章關鍵字 Excel VBA 條件

nsps5606

nsps5606
個人積分：489分
文章編號：78299477

489分

2樓

2020-07-12 16:16

怎麼可以沒有芒果！

可以試試看這樣，Sheets("001")是來源，Sheets("003")總表，自己調整一下

Sub Btn1_Click()
Dim myList As New Collection, cell As Range, itm
Dim i As Integer, idxCol As Integer, idxRow As Integer
Dim str As String, str2 As String

Sheets("001").Range("A2:B999").Sort key1:=Range("A2"), order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

idxCol = 0
idxRow = 0
str = ""
str2 = ""
For Each cell In Sheets("001").Range("A2:A999")
If cell <> "" And str <> cell.Value Then
idxCol = idxCol + 1
idxRow = 1
str = cell.Value
str2 = ""
Sheets("003").Cells(1, idxCol) = cell.Value
End If

If cell.Value <> "" And str2 <> cell.Offset(0, 1).Value Then
idxRow = idxRow + 1
str2 = cell.Offset(0, 1).Value
Sheets("003").Cells(idxRow, idxCol) = cell.Offset(0, 1).Value
End If
Next

End Sub

CK豬

CK豬
個人積分：8分
文章編號：78301382

8分

樓主

2020-07-12 20:08

nsps5606 wrote:
怎麼可以沒有芒果！可(恕刪)

芒果都被拿去做冰了,進不到貨

寫法太深奧了,我要消化一下, ^++^

CK豬

CK豬
個人積分：8分
文章編號：78301662

8分

樓主

2020-07-12 20:43

nsps5606 wrote:
怎麼可以沒有芒果！可(恕刪)

謝謝大大，
剛才測試了，可以一次把資料全帶入，
但目前只看得懂一點點的原理^^"，
如果我要以條件做單個年-月判定後，
做單一次執行(年-月不填入總表)，
且最好能有顯示符合條件的寫法^^

nsps5606

nsps5606
個人積分：489分
文章編號：78303999

489分

5樓

2020-07-13 0:57

CK豬 wrote:
芒果都被拿去做冰了,進不到貨

芒果好像都供不應求?
台灣的芒果乾貴的嚇人，去泰國才能1公斤1公斤的吃笑到噴淚

帶入條件可以這樣用:
Sub GetDistinctFruit(month As String)

Dim myList As New Collection, cell As Range, itm, i As Integer
Dim str As String

Sheets("001").Range("A2:B999").Sort key1:=Range("A2"), order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

str = ""
For Each cell In Sheets("001").Range("B2:B999")
If cell <> "" And str <> cell.Value And cell.Offset(0, -1).Value = month Then
myList.Add cell.Value, CStr(cell.Value)
str = cell.Value
End If
Next

i = 3
For Each itm In myList
Sheets("003").Cells(i, "D") = Format(itm, "@")
i = i + 1
Next
End Sub

再看要怎麼帶入條件和處理輸出
Sub Btn2_Click()
GetDistinctFruit "2020-02"
End Sub

Sub Btn3_Click()
Dim str As String
str = InputBox("輸入年月(格式yyyy-mm):")
If str <> "" Then
GetDistinctFruit str
End If
End Sub

CK豬

CK豬
個人積分：8分
文章編號：78304845

8分

樓主

2020-07-13 7:18

nsps5606 wrote:
芒果好像都供不應求?...(恕刪)

我試試，謝謝^o^

snare

snare
個人積分：3057分
文章編號：78304973

3057分

7樓

2020-07-13 7:49

這個問題用公式，會比用vba方便一些

公式解法，請參考

e3(陣列公式)，其它往右往下拉
=IFERROR(INDEX($B$2:$B$25, MATCH(0, COUNTIF(E2:E$2,$B$2:$B$25)+IF(E$1<>$A$2:$A$25, 1, 0), 0)), "")

CK豬

CK豬
個人積分：8分
文章編號：78308976

8分

樓主

2020-07-13 13:00

snare wrote:
這個問題用公式，會比...(恕刪)

我原本也用此函數，但資料量太大(幾萬筆)，明細只要有調整或篩選，就要重新計算0%～100%，所以才改學vba用寫的

CK豬

CK豬
個人積分：8分
文章編號：78314566

8分

樓主

2020-07-13 20:33

nsps5606 wrote:
GetDistinctFruit "2020-02"

完全看不懂,我再研究看看好了一.一"

CK豬

CK豬
個人積分：8分
文章編號：78315867

8分

樓主

2020-07-13 22:43

nsps5606 wrote:
芒果好像都供不應求?(恕刪)

有找到適合的程式，但不知道可否插入條件，
符合年-月條件才做回傳，可請大大再幫我看一下嗎

Sub 沒有芒果()

Dim i As Range
Dim n As Long
n = 2
For Each i In Sheets("資料明細").Range("a1:a9999")
If Application.WorksheetFunction.CountIf(Sheets("資料明細").Range("$A$1:" & i.Address), i) = 1 Then
Sheets("總表").Cells(n, 1) = i
n = n + 1
End If
Next
End Sub

excel vba 有條件的提取不重覆值 求救!!

excel vba 有條件的提取不重覆值求救!!