返回列表 上一主題 發帖

[發問] 無法執行vba

jim

帖子
87 
主題
26 
精華
0 
積分
119 
點名
0  
作業系統
win 7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
taiwan 
註冊時間
2010-5-7 
最後登錄
2020-9-28 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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
收藏 分享

jim

帖子
87 
主題
26 
精華
0 
積分
119 
點名
0  
作業系統
win 7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
taiwan 
註冊時間
2010-5-7 
最後登錄
2020-9-28 
7#
發表於 2011-4-19 22:10 | 只看該作者
Hsieh 多謝

TOP

jim

帖子
87 
主題
26 
精華
0 
積分
119 
點名
0  
作業系統
win 7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
taiwan 
註冊時間
2010-5-7 
最後登錄
2020-9-28 
6#
發表於 2011-4-18 20:56 | 只看該作者
Hsieh 老夏  多謝 研究後好像非所要結果
是否可查看壓縮檔book 1 thanks

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
256  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-26 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2011-4-18 18:30 | 只看該作者
本帖最後由 Hsieh 於 2011-4-18 18:32 編輯

回復 4# jim

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

剛錄製好的程式碼
  1. Sub Macro1()
  2. '
  3. ' Macro1 Macro
  4. ' Hsieh 在 2011/4/18 錄製的巨集
  5. '

  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
複製代碼
學海無涯_不恥下問

TOP

jim

帖子
87 
主題
26 
精華
0 
積分
119 
點名
0  
作業系統
win 7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
taiwan 
註冊時間
2010-5-7 
最後登錄
2020-9-28 
4#
發表於 2011-4-18 17:43 | 只看該作者
對不起 付上附件 請把修正後 VBA 貼在此 因我是小學生 謝謝

Book1.rar (3.99 KB)

TOP

jim

帖子
87 
主題
26 
精華
0 
積分
119 
點名
0  
作業系統
win 7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
來自
taiwan 
註冊時間
2010-5-7 
最後登錄
2020-9-28 
3#
發表於 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上

TOP

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
2#
發表於 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

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
返回列表 上一主題