質問です現在､最終行はCtrl+Endで空白行に移動しますﾃﾞｰﾀの終わりに必ずくるようにするにはどうしたらよいでしょうか sheet1に1行目からn行のﾃﾞｰﾀがありますこの…

人力検索はてな

ﾓﾊﾞｲﾙ版を表示しています｡PC版はこちら

質問です
現在､最終行はCtrl+Endで空白行に移動します
ﾃﾞｰﾀの終わりに必ずくるようにするにはどうしたら
よいでしょうか

sheet1に1行目からn行のﾃﾞｰﾀがあります
このn行のﾃﾞｰﾀをF列のある条件によって
sheet3
sheet5
sheet6
に振分けています
仮にこの結果ﾃﾞｰﾀ行が

sheet3 10行
sheet5 15行
sheet6 20行

となった場合S列まであるとして
最終行はCtrl+Endで(ﾃﾞｰﾀの終わり)
sheet3 S列の10行目
sheet5 S列の15行目
sheet6 S列の20行目

になるようにするにはどのような方法がありますか
ﾏｸﾛでできればお願いします
よろしくお願いします

AからS列までに空白列はあります
列の最終はS列で変わりません
行は常に変化しますn行です
できれば保存しないで解決したいです

●質問者: inosisi
●ｶﾃｺﾞﾘ:ｺﾝﾋﾟｭｰﾀ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

▽1 ● きゃづみぃ
●20ﾎﾟｲﾝﾄ

とりあえず最終列､行を選択するﾏｸﾛを作ってみました｡

Sub allctlend()
 For i = 1 To Sheets.Count
 Sheets(i).Select
 With ActiveSheet.UsedRange
 MaxRow = .Rows(.Rows.Count).Row
 MaxCol = .Columns(.Columns.Count).Column
 End With
 Sheets(i).Cells(MaxRow, MaxCol).Select
 Next
End Sub

inosisiさんのｺﾒﾝﾄ
ﾏｸﾛ実行すると空白の行に飛びますがﾃﾞｰﾀの最終行から空白行までを削除するﾏｸﾛをあわせてできますか空白行を削除してﾃﾞｰﾀの最終行へ飛びたいのですが

inosisiさんのｺﾒﾝﾄ
空白行を削除して保存したあとCtrl+Endするまたはﾏｸﾛ実行するととﾃﾞｰﾀの最終へ飛びますこの空白行を削除するﾏｸﾛはできますか

きゃづみぃさんのｺﾒﾝﾄ
途中の空白行を削除するということでしょうか？

きゃづみぃさんのｺﾒﾝﾄ
ﾏｸﾛは何かある行にとぶと思いますが･･･｡

inosisiさんのｺﾒﾝﾄ
はい途中の空白行を削除するﾏｸﾛですﾏｸﾛは何かある行にとぶとのことですが空白行にとびます見た目は空白行ですがなにかﾃﾞｰﾀがあるということでしょうか

inosisiさんのｺﾒﾝﾄ
このﾏｸﾛで最終列､行を選択するsheetは sheet3 sheet5 sheet6 のみに限定することはできますか

inosisiさんのｺﾒﾝﾄ
sheetが上記の3つに限定できれば空白行があるかないかの判断用ﾏｸﾛとして使いたいと思います

きゃづみぃさんのｺﾒﾝﾄ
このﾏｸﾛを変更しました｡ >|vb| Sub allctlend() For i = 1 To Sheets.Count s = Sheets(i).Name If s = "Sheet3" Or s = "Sheet5" Or s = "Sheet6" Then Sheets(i).Select With ActiveSheet.UsedRange MaxRow = .Rows(.Rows.Count).Row MaxCol = .Columns(.Columns.Count).Column End With Sheets(i).Cells(MaxRow, MaxCol).Select End If Next End Sub ||<

inosisiさんのｺﾒﾝﾄ
確認しましたありがとうございました

▽2 ● きゃづみぃ
●40ﾎﾟｲﾝﾄ

Sub allctlend()
 Dim MaxRow As Long
 Dim MaxCol As Long
 Dim i As Long
 Dim b As Long
 
 
 For i = 1 To Sheets.Count
 Sheets(i).Select
 With ActiveSheet.UsedRange
 MaxRow = .Rows(.Rows.Count).Row
 MaxCol = .Columns(.Columns.Count).Column
 End With
 For b = MaxRow To 1 Step -1
 If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
 Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
 End If
 Next b
 
 With ActiveSheet.UsedRange
 MaxRow = .Rows(.Rows.Count).Row
 MaxCol = .Columns(.Columns.Count).Column
 End With
 Sheets(i).Cells(MaxRow, MaxCol).Select
 Next
End Sub

こちらはどうかな？

inosisiさんのｺﾒﾝﾄ
うまくいきましたありがとうございますあと申し訳ないですがsheetに名前をつけていますので do au sb この3つのみに限定してﾏｸﾛ実行できるようにおねがいしますよろしくお願いします

きゃづみぃさんのｺﾒﾝﾄ
変更に対応するのはどのﾏｸﾛでしょうか？一番目？二番目？三番目？

inosisiさんのｺﾒﾝﾄ
sheet3(do) sheet5(au) sheet6(sb) になります

inosisiさんのｺﾒﾝﾄ
変更に対応するのはどのﾏｸﾛでしょうか？ No2とNo3です

きゃづみぃさんのｺﾒﾝﾄ
>|vb| Sub allctlend() Dim MaxRow As Long Dim MaxCol As Long Dim i As Long Dim b As Long For i = 1 To Sheets.Count If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then Sheets(i).Select With ActiveSheet.UsedRange MaxRow = .Rows(.Rows.Count).Row MaxCol = .Columns(.Columns.Count).Column End With For b = MaxRow To 1 Step -1 If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp End If Next b With ActiveSheet.UsedRange MaxRow = .Rows(.Rows.Count).Row MaxCol = .Columns(.Columns.Count).Column End With Sheets(i).Cells(MaxRow, MaxCol).Select End If Next End Sub ||<

inosisiさんのｺﾒﾝﾄ
ありがとうございましたお手数おかけしましたうまくいきました

▽3 ● きゃづみぃ
●40ﾎﾟｲﾝﾄ

ﾍﾞｽﾄｱﾝｻｰ

もひとつ


Sub allctlend2()
 Dim MaxRow As Long
 Dim MaxCol As Long
 Dim i As Long
 Dim b As Long
 
 
 For i = 1 To Sheets.Count
 Sheets(i).Select
 With ActiveSheet.UsedRange
 MaxRow = .Rows(.Rows.Count).Row
 MaxCol = .Columns(.Columns.Count).Column
 End With
 For b = MaxRow To 1 Step -1
 If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
 Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
 Else
 Exit For
 End If
 Next b
 
 With ActiveSheet.UsedRange
 MaxRow = .Rows(.Rows.Count).Row
 MaxCol = .Columns(.Columns.Count).Column
 End With
 Sheets(i).Cells(MaxRow, MaxCol).Select
 Next
End Sub

最終行と判断された行からﾃﾞｰﾀがある行までを削除｡

inosisiさんのｺﾒﾝﾄ
sheet3(do) sheet5(au) sheet6(sb) この3つのみに限定してﾏｸﾛ実行できるようにおねがいしますよろしくお願いします

inosisiさんのｺﾒﾝﾄ
変更に対応するのはどのﾏｸﾛでしょうか？ No2とNo3です

きゃづみぃさんのｺﾒﾝﾄ
>|vb| Sub allctlend() Dim MaxRow As Long Dim MaxCol As Long Dim i As Long Dim b As Long For i = 1 To Sheets.Count If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then Sheets(i).Select With ActiveSheet.UsedRange MaxRow = .Rows(.Rows.Count).Row MaxCol = .Columns(.Columns.Count).Column End With For b = MaxRow To 1 Step -1 If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp Else Exit For End If Next b With ActiveSheet.UsedRange MaxRow = .Rows(.Rows.Count).Row MaxCol = .Columns(.Columns.Count).Column End With Sheets(i).Cells(MaxRow, MaxCol).Select End If Next End Sub ||< ｼｰﾄ名は If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then の箇所を変更してください｡

inosisiさんのｺﾒﾝﾄ
ありがとうございましたお手数おかけしましたうまくいきました