該如何輸入完資料後,自動往下一儲存格繼續輸入資料 - Excel程式區

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

1^# 跳轉到 »

發表於 2011-7-19 13:39 | 顯示全部帖子

回復 1# yueh0720
該工作表儲存格有輸入時的預設事件

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, R1%, R2%
Set Rng = Range("B2").CurrentRegion
'CurrentRegion以任意空白列及空白欄的組合為邊界的連續範圍
If Not Application.Intersect(Target(1), Rng) Is Nothing Then 'Rng的範圍包含Target(1)的位址
'Target(1) ->工作表所選擇範圍的第一個儲存格
If Target(1).Row = Rng.Row Then Exit Sub ' 在第一列
R1 = Rng.Column '第一欄的欄數
R2 = Rng(1, Rng.Columns.Count).Column '最後一欄的欄數
If Application.CountA(Range(Cells(Target(1).Row, R1), Cells(Target(1).Row, R2))) = Rng.Columns.Count Then
'有資料數的儲存格=Rng的總欄數
Cells(Target(1).Row + 1, R1).Select '選擇下一列的第1欄
End If
End If
End Sub

複製代碼

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

2^#

發表於 2011-7-19 16:32 | 顯示全部帖子

回復 3# yueh0720
試試看

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, R1%, R2%
Set Rng = Range("B2").CurrentRegion
'CurrentRegion以任意空白列及空白欄的組合為邊界的連續範圍
If Not Application.Intersect(Target(1), Rng) Is Nothing Then 'Rng的範圍包含Target(1)的位址
'Target(1) ->工作表所選擇範圍的第一個儲存格
If Target(1).Row = Rng.Row Then Exit Sub ' 在第一列
R1 = Rng.Column '第一欄的欄數
R2 = Rng(1, Rng.Columns.Count).Column '最後一欄的欄數
If Application.CountA(Range(Cells(Target(1).Row, R1), Cells(Target(1).Row, R2))) = Rng.Columns.Count Then
'有資料數的儲存格=Rng的總欄數
Cells(Target(1).Row + 1, R1).Select '選擇下一列的第1欄
Else '有資料數的儲存格<>Rng的總欄數
If Target(1) <> "" Then
R2 = IIf(Target(1).Column = R2, R1, Target(1).Column + 1)
'如為最後一欄的返回第1欄否往右一欄
Cells(Target(1).Row, R2).Select '往右一欄
End If
End If
End If
End Sub