請問程式高手
我有一個EXCEL檔案內容如下A欄為流水號，B欄為物品類別，C欄為價格
A B C
1 甲 50
2 乙 20
3 甲 20
4 丙 20
5 乙 25
我要如何在 B 欄屬於乙時，將A欄相對應的流水號複製到 E欄
如下
E
2
5
以上要如何攥寫VBA程式
EXCEL VBA篩選並複製的程式
2009-10-24 11:51 pm
回答 (4)
2009-10-25 4:29 am
✔ 最佳答案
在VBA Sheet1 之編程如下Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$1" Then Exit Sub
Range("E2:E500").Clear
For i = 2 To [B65536].End(xlUp).Row
If Cells(i, 2) = [D1] Then
last_row = [E65536].End(xlUp).Row + 1
Cells(last_row, 5) = Cells(i, 1)
End If
Next i
End Sub
參考如下附檔:
http://www.FunP.Net/573791
2009-10-25 7:23 am
換個寫法參考
Sub Macro1()
Range("A:C").AutoFilter Field:=2, Criteria1:="乙"
Range("A2", [A65536].End(xlUp)).Copy Range("E1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub Macro1()
Range("A:C").AutoFilter Field:=2, Criteria1:="乙"
Range("A2", [A65536].End(xlUp)).Copy Range("E1")
ActiveSheet.AutoFilterMode = False
End Sub
2009-10-25 3:30 am
如果A欄流水號非純數字，或者純數字而非且是由小而大順序，公式如下：
E2
=INDIRECT("A"&SMALL(IF(B$2:B$1000="乙",ROW($2:$1000)),ROW()-1))
Ctrl-Shift-Enter 三鍵連按 ，向下拉
（這條是陣列公式）
2009-10-24 19:36:00 補充：
VBA:
～～～
Sub X()
ER = 1
For R = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(R, 2) = "乙" Then
ER = ER + 1
Cells(ER, 5) = Cells(R, 1)
End If
Next
End Sub
E2
=INDIRECT("A"&SMALL(IF(B$2:B$1000="乙",ROW($2:$1000)),ROW()-1))
Ctrl-Shift-Enter 三鍵連按 ，向下拉
（這條是陣列公式）
2009-10-24 19:36:00 補充：
VBA:
～～～
Sub X()
ER = 1
For R = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(R, 2) = "乙" Then
ER = ER + 1
Cells(ER, 5) = Cells(R, 1)
End If
Next
End Sub
2009-10-25 3:25 am
收錄日期: 2021-04-27 17:04:08
原文連結 [永久失效]:
https://hk.answers.yahoo.com/question/index?qid=20091024000016KK05345