再請教一個VBA語法的問題

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

13^#

發表於 2012-8-21 09:26 | 只看該作者

感謝版主大大的解惑，小弟先去測試看看。先謝啦！（真是就感心的論壇）

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

12^#

發表於 2012-8-21 05:48 | 只看該作者

回復 11# skyutm

Worksheets("期中評量").Range(Cells(3, 2), Cells(3, 2).End(xlDown)).Copy Worksheets("期中成績"), Cells(5, 2)

複製代碼

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

11^#

發表於 2012-8-21 00:19 | 只看該作者

大家好！又要麻煩各位先進了。小弟的進度遇到困難。問題是我想把期中評量（sheet2）的b3欄位的名字複製到期中成績（sheet3）的b5欄位。語法如下：

Worksheets("期中評量").Range(cells(3, 2), cells(3, 2).End(xlDown)).Copy
ActiveSheet.Paste Destination:=Worksheets("期中成績").Range(cells(5, 2), cells(5, 2).End(xlDown))

可是一直無法執行，可否幫忙解決，謝謝！

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

10^#

發表於 2012-8-17 22:16 | 只看該作者

感謝white945大大的回覆，我先去做一下功課，有問題再來請教，先謝謝了！

white945

小學生 Rank: 1

帖子: 23
主題: 0
精華: 0
積分: 31
點名: 0
作業系統: Win7
軟體版本: 20xx
閱讀權限: 10
性別: 男
註冊時間: 2012-8-11
最後登錄: 2012-8-28

9^#

發表於 2012-8-17 19:40 | 只看該作者

回復 9# skyutm
兩個程式碼應該合併

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J1:J3]) Is Nothing Or [J3] = 0 Then Exit Sub
ReDim ar(1 To [J3])
YC = [J1] & Format([J2], "00")
For i = 1 To [J3]
ar(i) = YC & Format(i, "00")
Next
With Sheets(4)
.Cells.Rows.Hidden = False
.Cells.Columns.Hidden = False
.[A:A] = ""
.[A3].Resize([J3], 1) = Application.Transpose(ar)
.Range("C1", .Cells(1, .Columns.Count)).EntireColumn.Hidden = True
.Range(.[A3].Offset([J3], 0), .Cells(Rows.Count, 1)).EntireRow.Hidden = True
End With
End Sub

複製代碼

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

8^#

發表於 2012-8-17 18:22 | 只看該作者

感謝white945大大的回覆，但是有一個小問題，因為[B1:B3]是先填B1所以會出現陣列超出索引範圍的錯誤訊息，我猜可能是因為B3還沒填數字 ReDim ar(1 To [B3])
另外還有
承蒙大家的幫助，我把前面兩位好心人的語法加以修改後，變成下列兩式但是再把它們放在第一個工作表的時候卻會出現問題，想請問論壇的大大，問題是出在哪裡，感謝指教！
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$3" Then
      If Sheet2.Range("A1048576").EntireRow.Hidden Then
         Sheet2.Cells.EntireRow.Hidden = False
         Sheet2.Cells.EntireColumn.Hidden = False
      End If
      Sheet2.Range(Sheet2.Range("A" & Target.Value + 3), Sheet2.Range("A3").End(xlDown)).EntireRow.Hidden = True
      Sheet2.Range(Sheet2.Range("W1"), Sheet2.Range("W1").End(xlToRight)).EntireColumn.Hidden = True
End If
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J1:J3]) Is Nothing Then Exit Sub
ReDim ar(1 To [J3])
YC = [J1] & Format([J2], "00")
For i = 1 To [J3]
ar(i) = YC & Format(i, "00")
Next
Sheets(2).[A:A] = ""
Sheets(2).[A3].Resize([J3], 1) = Application.Transpose(ar)
End Sub