麻辣家族討論版版 » Excel程式區 » 無法執行vba

返回列表下一主題上一主題發帖

[發問] 無法執行vba

中學生 Rank: 2

帖子: 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

樓主熱帖

收藏

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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上

中學生 Rank: 2

帖子: 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)

超級版主 Rank: 8 Rank: 8

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

2024年全勤獎章 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

剛錄製好的程式碼

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

複製代碼

錄製後再做修改即可

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

複製代碼

學海無涯_不恥下問

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 87
主題: 26
精華: 0
積分: 119
點名: 0
作業系統: win 7
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: taiwan
註冊時間: 2010-5-7
最後登錄: 2020-9-28

7^#

發表於 2011-4-19 22:10 | 只看該作者

Hsieh 多謝

靜思自在 : 並非有錢魷是快樂，問心無愧心最安。

返回列表下一主題上一主題