標題: 請問用自訂清單，來進階篩選出資料? [打印本頁]

---

作者: gaishutsusuru    時間: 2019-5-7 23:49     標題: 請問用自訂清單，來進階篩選出資料?

[attach]30540[/attach]

在儲存格G1，是自訂清單。

想要將左邊的資料，依自訂清單，進階篩選成右邊的資料，請問要如何才能做到呢?


謝謝大家的協助。感謝。

---

作者: rouber590324    時間: 2019-5-8 11:09

如下
執行  robert  即可


Sub robert()
Application.Run "robert1"
Application.Run "robert2"
End Sub

Sub robert1()
Sheet1.[K265536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
Y = Sheet1.[K65536].End(xlUp).Row
For M = 2 To X
If Sheet1.Cells(M, 1) = Sheet1.Cells(2, 7) Then
  Sheet1.Cells(Y + 1, 11) = Sheet1.Cells(M, 1)
  Sheet1.Cells(Y + 1, 12) = Sheet1.Cells(M, 2)
    Y = Y + 1
  End If
  Next
End Sub

Sub robert2()
X = Sheet1.[A65536].End(xlUp).Row
Y = Sheet1.[K65536].End(xlUp).Row
For M = 2 To X
If Sheet1.Cells(M, 1) = Sheet1.Cells(3, 7) Then
  Sheet1.Cells(Y + 1, 11) = Sheet1.Cells(M, 1)
  Sheet1.Cells(Y + 1, 12) = Sheet1.Cells(M, 2)
    Y = Y + 1
  End If
  Next
End Sub

---

作者: rouber590324    時間: 2019-5-8 14:56

Sub robert()
Sheet1.[K265536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
Y = Sheet1.[K65536].End(xlUp).Row
For M = 2 To X
For K = 2 To 10
If Sheet1.Cells(M, 1) = Sheet1.Cells(K, 7) Then
  Sheet1.Cells(Y + 1, 11) = Sheet1.Cells(M, 1)
  Sheet1.Cells(Y + 1, 12) = Sheet1.Cells(M, 2)
    Y = Y + 1
  End If
Next
Next
End Sub

---

作者: 准提部林    時間: 2019-5-11 11:55

回復 1# gaishutsusuru


上傳檔案是最基本的, 大家不想為了解題還另花時間去建樣本檔~~

---

作者: gaishutsusuru    時間: 2019-5-11 23:23

回復 4# 准提部林

您好，不好意思。因為上次沒注意看要用壓縮檔上傳，以為是不能上傳。

附上檔案，再麻煩您與各位大大協助，感謝。

    [attach]30568[/attach]

---

作者: 准提部林    時間: 2019-5-12 09:36

回復 5# gaishutsusuru


陣列公式(三鍵完成)
=INDEX(A:A,SMALL(IF(COUNTIF($G:$G,$A$2:$A$99),ROW($2:$99),4^8),ROW(A1)))&""
右拉/下拉
註:此公式如果皆為[文字格式]

或:
=IFERROR(INDEX(A:A,SMALL(IF(COUNTIF($G:$G,$A$2:$A$99),ROW($2:$99)),ROW(A1))),"")

---

作者: gaishutsusuru    時間: 2019-5-12 23:29

回復 6# 准提部林


    謝謝您的協助。

---

作者: gaishutsusuru    時間: 2019-5-12 23:31

回復 3# rouber590324


您好，我將您提供的巨集碼複製後，要執行時，會出現錯誤：424，此處需要物件。

請問如何處理呢，謝謝

---

作者: 准提部林    時間: 2019-5-16 10:30

可以用[進階篩選]
Sub 條件篩選()
Dim cRNG As Range
[I:J].Clear
Set cRNG = Range([G1], [G65536].End(xlUp))
If cRNG.Count = 1 Then Exit Sub
Range("A:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=cRNG, _
     CopyToRange:=Range("I1:J1"), Unique:=False
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)