[[20230310190044]]　『行にカウントアップをリベンジしたいです。』（どどど）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『行にカウントアップをリベンジしたいです。』（どどど）

Sub カウントアップ() 

    i = 40                           '40行目から開始


                                      'BA列もしくはBB列もしくは・・CW列が空白ではない場合に
     Do While Cells(i, "") <> "" Or Cells(i, "BA") <> "" Or Cells(i, "BB") <> "" Or Cells(i, "BC") <> "" Or Cells(i, "BD") <> "" Or Cells(i, "BE") <> "" Or Cells(i, "BF") <> "" Or Cells(i, "BG") <> "" Or Cells(i, "BH") <> "" Or Cells(i, "BI") <> "" Or Cells(i, "BJ") <> "" Or Cells(i, "BK") <> "" Or Cells(i, "BL") <> "" Or Cells(i, "BM") <> "" Or Cells(i, "BN") <> "" Or Cells(i, "BO") <> "" Or Cells(i, "BP") <> "" Or Cells(i, "BQ") <> "" Or Cells(i, "BR") <> "" Or Cells(i, "BS") <> "" Or Cells(i, "BT") <> "" Or Cells(i, "BU") <> "" Or Cells(i, "BV") <> "" Or Cells(i, "BW") <> "" Or Cells(i, "BX") <> "" Or Cells(i, "BY") <> "" Or Cells(i, "BZ") <> "" _
                                Or Cells(i, "CA") <> "" Or Cells(i, "CB") <> "" Or Cells(i, "CC") <> "" Or Cells(i, "CD") <> "" Or Cells(i, "CE") <> "" Or Cells(i, "CF") <> "" Or Cells(i, "CG") <> "" Or Cells(i, "CH") <> "" Or Cells(i, "CI") <> "" Or Cells(i, "CJ") <> "" Or Cells(i, "CK") <> "" Or Cells(i, "CL") <> "" Or Cells(i, "CM") <> "" Or Cells(i, "CN") <> "" Or Cells(i, "CO") <> "" Or Cells(i, "CP") <> "" Or Cells(i, "CQ") <> "" Or Cells(i, "CR") <> "" Or Cells(i, "CS") <> "" Or Cells(i, "CT") <> "" Or Cells(i, "CU") <> "" Or Cells(i, "CV") <> "" Or Cells(i, "CW") <> "" Or Cells(i, "CX") <> "" Or Cells(i, "CY") <> "" Or Cells(i, "CZ") <> "" _


        Cells(i, "B") = i - 39         'B40=40-39で1が入る
        i = i + 1                      'カウントアップ
    Loop

End Sub

BA列からCC列までの40行目から最大の行を取得してB列にカウントさせています。

希望としてはこれをまず短くしたいです。

それと条件を追加したいです。

B列40行目を下から上に空白行を取得してそこからBA列〜CC列の最大行まで1,2,3とカウントアップ
させていく。

例えばB列40行目から55行目まで空白でなかった場合
56行目から1,2,3とカウントアップしていき
BA列からCC列までの最大の行まで取得させたいです。

よろしくお願いします。

＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞

コードと質問内容から希望動作が読めないので、レイアウトと結果図を提示してもらえると助かります。 

 >BA列からCC列までの40行目から最大の行を取得してB列にカウントさせています。
そもそもエラーになるんですが・・・
（フォーキー） 2023/03/10(金) 19:36:33

 コードではBA-CZだったのでそれで・・・
 どれか一つでも文字か数字が入っていれば、+1ってことでいいんですよね？
    Sub カウントアップ()
        Dim i As Long
        Dim cnt As Long
        'B列の最終行+1を取り出す
        i = Cells(Rows.Count, "B").End(xlUp).Offset(1).Row
        'B列の最終行が40以下なら処理を中断
        If i <= 40 Then
            MsgBox "B列の最大値が40行より小さいです。処理を中断します"
            Exit Sub
        End If
        'BA列もしくはBB列もしくは・・CW列が空白ではない場合に
        Do
            'BA:CZのi行目をCOUNTIFで空白以外を数える
            cnt = WorksheetFunction.CountIf(Application.Index(Range("BA:CZ"), i, 0), "<>")
            'すべてつなげたとき、空白でなければ、カウントアップ
            If cnt > 0 Then
                Cells(i, "B") = i - 39
                i = i + 1
            Else
                '空白なら処理を終了
                MsgBox i - 1 & "行まで処理しました"
                Exit Do
            End If
        Loop
    End Sub
（稲葉） 2023/03/10(金) 19:55:57
コメント頂いてる最中に調べたり書いてりしていたので話がかみ合わなくてすみません。
それと手直し中でした。

Sub カウントアップ() 

   Dim i As Long


    i = 40


    Do While WorksheetFunction.CountA(Range("BA" & i & ":CZ" & i)) > 0
        Cells(i, "B") = i - 39
        i = i + 1
    Loop

End Sub

これでBA〜CZのどこか一つでも文字が入っていればその最大をB40に1からカウントさせています。

これに加えたい条件は
●1からカウントさせるのは40行目ではなく、B列を下から取得した空白行からにする
(Bが56行目まで埋まっていたとしたら57行目から1のカウントを開始する。

●下から取得してB40が空白だったら今まで通り、B40を1でカウントを開始する。

●BA〜AZの最大行よりB列の行の方が埋まっていた場合は何もしない

を希望しています。

今も調べていますが、かみ合わなくて申し訳ございません。

（どどど） 2023/03/10(金) 20:29:37

書きためている間に話が進んでいるようですが投稿しておきます。

■１
＞BA列からCC列までの40行目から最大の行を取得してB列にカウントさせています。
↑の意味が理解できませんが

＞希望としてはこれをまず短くしたいです。
↑について、提示のコードがすごく見ずらいので適当に改行してみました。 

    Sub カウントアップ()
        i = 40                           '40行目から開始
                                          'BA列もしくはBB列もしくは・・CW列が空白ではない場合に
         Do While Cells(i, "??") <> "" Or _
                        Cells(i, "BA") <> "" Or Cells(i, "BB") <> "" Or Cells(i, "BC") <> "" Or Cells(i, "BD") <> "" Or Cells(i, "BE") <> "" Or _
                        Cells(i, "BF") <> "" Or Cells(i, "BG") <> "" Or Cells(i, "BH") <> "" Or Cells(i, "BI") <> "" Or Cells(i, "BJ") <> "" Or _
                        Cells(i, "BK") <> "" Or Cells(i, "BL") <> "" Or Cells(i, "BM") <> "" Or Cells(i, "BN") <> "" Or Cells(i, "BO") <> "" Or _
                        Cells(i, "BP") <> "" Or Cells(i, "BQ") <> "" Or Cells(i, "BR") <> "" Or Cells(i, "BS") <> "" Or Cells(i, "BT") <> "" Or _
                        Cells(i, "BU") <> "" Or Cells(i, "BV") <> "" Or Cells(i, "BW") <> "" Or Cells(i, "BX") <> "" Or Cells(i, "BY") <> "" Or _
                        Cells(i, "BZ") <> "" Or Cells(i, "CA") <> "" Or Cells(i, "CB") <> "" Or Cells(i, "CC") <> "" Or Cells(i, "CD") <> "" Or _
                        Cells(i, "CE") <> "" Or Cells(i, "CF") <> "" Or Cells(i, "CG") <> "" Or Cells(i, "CH") <> "" Or Cells(i, "CI") <> "" Or _
                        Cells(i, "CJ") <> "" Or Cells(i, "CK") <> "" Or Cells(i, "CL") <> "" Or Cells(i, "CM") <> "" Or Cells(i, "CN") <> "" Or _
                        Cells(i, "CO") <> "" Or Cells(i, "CP") <> "" Or Cells(i, "CQ") <> "" Or Cells(i, "CR") <> "" Or Cells(i, "CS") <> "" Or _
                        Cells(i, "CT") <> "" Or Cells(i, "CU") <> "" Or Cells(i, "CV") <> "" Or Cells(i, "CW") <> "" Or Cells(i, "CX") <> "" Or _
                        Cells(i, "CY") <> "" Or Cells(i, "CZ") <> ""


            Cells(i, "B") = i - 39         'B40=40-39で1が入る
            i = i + 1                      'カウントアップ
        Loop
    End Sub


 ※１　最初の「Cells(i, "")」はミスタイプだと思うのでダミーにしています。
 ※２　「Cells(i, "CZ") <> ""」の後ろの改行もミスだと思うので外しました。

そして、ミスタイプと思われる最初を除けばやっていることは、i行のBA〜CZまで連続するセル範囲の【どこか一つでも】空白じゃなければ、繰り返し処理しなさいって命令になっているわけですよね。
それならば、以下のように１セルずつ書かなくても 

    Do While Cells(i, "BA") <> "" Or Cells(i, "BB") <> "" Or Cells(i, "BC") <> "" Or Cells(i, "BD") <> "" Or Cells(i, "BE") <> "" Or _
             Cells(i, "BF") <> "" Or Cells(i, "BG") <> "" Or Cells(i, "BH") <> "" Or Cells(i, "BI") <> "" Or Cells(i, "BJ") <> "" Or _
             Cells(i, "BK") <> "" Or Cells(i, "BL") <> "" Or Cells(i, "BM") <> "" Or Cells(i, "BN") <> "" Or Cells(i, "BO") <> "" Or _
             Cells(i, "BP") <> "" Or Cells(i, "BQ") <> "" Or Cells(i, "BR") <> "" Or Cells(i, "BS") <> "" Or Cells(i, "BT") <> "" Or _
             Cells(i, "BU") <> "" Or Cells(i, "BV") <> "" Or Cells(i, "BW") <> "" Or Cells(i, "BX") <> "" Or Cells(i, "BY") <> "" Or _
             Cells(i, "BZ") <> "" Or Cells(i, "CA") <> "" Or Cells(i, "CB") <> "" Or Cells(i, "CC") <> "" Or Cells(i, "CD") <> "" Or _
             Cells(i, "CE") <> "" Or Cells(i, "CF") <> "" Or Cells(i, "CG") <> "" Or Cells(i, "CH") <> "" Or Cells(i, "CI") <> "" Or _
             Cells(i, "CJ") <> "" Or Cells(i, "CK") <> "" Or Cells(i, "CL") <> "" Or Cells(i, "CM") <> "" Or Cells(i, "CN") <> "" Or _
             Cells(i, "CO") <> "" Or Cells(i, "CP") <> "" Or Cells(i, "CQ") <> "" Or Cells(i, "CR") <> "" Or Cells(i, "CS") <> "" Or _
             Cells(i, "CT") <> "" Or Cells(i, "CU") <> "" Or Cells(i, "CV") <> "" Or Cells(i, "CW") <> "" Or Cells(i, "CX") <> "" Or _
             Cells(i, "CY") <> "" Or Cells(i, "CZ") <> ""


                   ↓


    Do While Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range(Cells(i, "BA"), Cells(i, "CZ")).Value)), "") <> ""

とか 

    Do While Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Cells(i, "BA").Resize(, 52).Value)), "") <> ""

のようにすればよかったりしませんか？

■２
＞BA列からCC列までの最大の行まで取得させたいです。
そういった話ならば、Do〜Loopより、BA列からCC列までの最終行のうち一番大きいものを求め、40行目から求めた最終行までをFor〜Nextでループするというアプローチも有効だと思います。
（自分でカウントアップさせる必要がありませんし、場合によっては一切処理をしない（すべての列の最終行が40未満）といったケースにも対応できます）

（もこな２） 2023/03/10(金) 20:32:19

 こんな感じでしょうか。
 ※最初はBA〜CCだったのに、次の投稿ではBA〜CZとBA〜AZになってますが、どれが正しいんでしょうか。
 ※下のコードはCCを最終列としているので、もし変える場合は
 >Set rng = Range("BA40").CurrentRegion.Resize(, 29) の29の部分を変更してください。
 (29はBA列からCC列までの列数）
 ※BA〜CZとBA〜AZが正しい場合、下のコードでは対応できません。


 Sub test()
     Dim rng As Range, LastR As Long
     LastR = Cells(Rows.Count, "B").End(xlUp).Offset(1).Row
     Set rng = Range("BA40").CurrentRegion.Resize(, 29)
     If WorksheetFunction.CountA(rng) = 0 Then Exit Sub


     '取得セル範囲の最上行が40行より小さければ、40行目を起点に範囲を修正
     If rng.Row < 40 Then
         With rng.Offset(40 - rng.Row, 0)
             Set rng = .Resize(.Rows.Count - (40 - rng.Row))
         End With
     End If


     '取得セル範囲の最右列がBA列(53)より小さければ、BA列目を起点に範囲を修正
     If rng.Column < 53 Then Set rng = rng.Offset(0, 53 - rng.Column)


     If rng.Rows.Count < LastR - 40 Then Exit Sub
     If LastR <= 40 Then
         Range("B40") = 1
     Else
         Cells(LastR, "B") = 1
     End If
     With Cells(LastR + 1, "B").Resize(rng.Rows.Count - 1)
         .Formula = "=B" & LastR & "+1"
         .Value = .Value
     End With
 End Sub
（フォーキー） 2023/03/10(金) 21:21:46
皆様、ご迷惑をおかけしました。スマートフォンからリモートデスクトップで無理やりエクセルを操作しているもので、これも言い訳になります。すみません。

フォーキーさんのモジュールを貼り付けさせてもらいましたが
一番希望に近い状態になります。

が、、後付けというか想定していませんでした。

B列のカウントアップは範囲列の最大行より超えない。最大行に達したらストップさせたいです。

指定した範囲列の中で最大行が例えばBP700までだったとする

そしてBは元々500まで埋まっていたとすると501行目から1,2,3とカウントアップを始めるが
B700まで行ったらカウントは止まる
あくまでカウントは指定した範囲列の最大行を超えなくしたいです。

（どどど） 2023/03/10(金) 22:03:57

 ※希望通りの結果にする、というコードなので、可読性とメンテナンス性は悪いです。


 Sub test()
     Dim rng As Range, LastR As Long
     LastR = Cells(Rows.Count, "B").End(xlUp).Offset(1).Row
     Set rng = Range("BA40").CurrentRegion.Resize(, 29)
     If WorksheetFunction.CountA(rng) = 0 Then Exit Sub


     '範囲の行数が40行より小さければ、40行目を起点に範囲を修正
     If rng.Row < 40 Then
         With rng.Offset(40 - rng.Row, 0)
             Set rng = .Resize(.Rows.Count - (40 - rng.Row))
         End With
     End If


     '範囲の列数がBA列(53)より小さければ、BA列目を起点に範囲を修正
     If rng.Column < 53 Then Set rng = rng.Offset(0, 53 - rng.Column)


     If rng.Rows.Count <= LastR - 40 Then Exit Sub
     If LastR <= 40 Then
         Range("B40") = 1
         LastR = 39
     Else
         Cells(LastR, "B") = 1
     End If
     With Cells(LastR + 1, "B").Resize(rng.Rows.Count - (LastR - 39))
         .Formula = "=B" & LastR & "+1"
         .Value = .Value
     End With
 End Sub
（フォーキー） 2023/03/10(金) 22:23:35
コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.