標題: [發問] 無法執行vba [打印本頁]

---

作者: jim    時間: 2011-4-18 16:21     標題: 無法執行vba

各位高手請指導修改vba
  我要把 sheet1中 以 Dve行中有 K值之各欄 貼到 sheet2  A5欄 如下
        sheet1                                 sheet2
1   Item  Des    Dve  Ets               
2   AA     BB       K     EE                k
3   A1     B1       2     E1              
4   A2     B2       X     C2             Item  Des    Dve   Ets
5   A3     A3       K    C4               AA    BB       K      EE
6   A4     B4       Y    C5               A3     A3      K      C4

Sub kkk ( )
Sheets(2).Range("A5:D" & Sheets(2).[a65536].End(xlUp).Row + 1).ClearContents
For i = 2 To [a65536].End(xlUp).Row
If Cells(i, 3) = Sheets(2).[A2] Then
k = Sheets(2).[a65536].End(xlUp).Row + 1
Range("a" & i & ": d" & i).Copy Sheets(2).Range("a" & k)
k = k + 1
End If
Next i
end sub

---

作者: chin15    時間: 2011-4-18 16:40

Sub kkk()
Set a = Sheet1.UsedRange
With Sheet2
.[a1] = "Dve"
.UsedRange.Offset(2, 0) = ""
a.AdvancedFilter 2, .[a1:a2], .[A4]
End With
End Sub

---

作者: jim    時間: 2011-4-18 17:15

回復 2# chin15


    chin15
     謝謝你的指導 但是程式上執行後是全部貼上而沒分類
    或許我沒說清楚 Sheet2上的a2儲存格值是 變數  (  Item   Des    Dve   Ets 是抬頭單位 )
  當Sheet2上的a2儲存格值是 k 時則 Dve行屬於 k 時則Sheet1 第 2 , 5 行則貼在Sheet2上a5及a6 Row上
  當Sheet2上的a2儲存格值是 X 時則 Dve行屬於 X 時則Sheet1 第 4  行則貼在Sheet2上a5 Row上

---

作者: jim    時間: 2011-4-18 17:43

對不起 付上附件 請把修正後 VBA 貼在此 因我是小學生 謝謝

---

作者: Hsieh    時間: 2011-4-18 18:30

本帖最後由 Hsieh 於 2011-4-18 18:32 編輯

回復 4# jim

新手可先從錄製巨集著手，錄製進階篩選即可得
必須在目標工作表Sheet2做進階篩選
資料範圍是Sheet1的A:D欄
以Sheet2!A1:A2作為準則範圍
複製到Sheet2!A4:D4
[attach]5478[/attach]
剛錄製好的程式碼

1. Sub Macro1()
   
2. '
   
3. ' Macro1 Macro
   
4. ' Hsieh 在 2011/4/18 錄製的巨集
   
5. '
   
6. 
   
7. '
   
8.    Sheets("Sheet1").Range("A1:A9").AdvancedFilter Action:=xlFilterCopy, _
   
9.         CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:D4"), Unique:=False
   
10. End Sub

複製代碼

錄製後再做修改即可

1. Sub Macro1()
   
2.    Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
   
3.         CriteriaRange:=Sheets("Sheet2").Range("A1:A2"), CopyToRange:=Sheets("Sheet2").Range("A4:D4"), Unique:=False
   
4. End Sub

複製代碼

---

作者: jim    時間: 2011-4-18 20:56

Hsieh 老夏  多謝 研究後好像非所要結果
是否可查看壓縮檔book 1 thanks

---

作者: jim    時間: 2011-4-19 22:10

Hsieh 多謝

---

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