none
VBAのコードをご教授願います RRS feed

  • 質問

  • お世話になります。

    A5~A9全てに1が、B4~B9全てに2が、C3~C9全てに3が入っているとします。(ほかのセルは全て空白)
    セルA10 B10 C10それぞれから上に向かって空白の直前の行番号を抽出して、行番号が2番目に大きいセルに入っている値をMSGBOXで表示するということを(つまりB4の2をMSGBOXに表示したい)

    MsgBox WorksheetFunction.Large(Range("A10, B10, C10"), 2)

    と.End(xlUp).Rowを組み合わせてやってみましたが上手くいきません。
    Large関数と.End(xlUp).Rowの組み合わせは難しいのでしょうか。

    いいコードの書き方がありましたらご教授頂けるととても助かります。
    どうぞよろしくお願い致します。




    2020年2月8日 9:29

回答

  • セルA10 B10 C10それぞれから上に向かって空白の直前の行番号を抽出して、行番号が2番目に大きいセル

    もしも C3 セルが 3 ではなく空欄だった場合、
    行番号が2番目に大きい場所は B4 と C4 の 2 箇所ということになりますが、
    その場合は MsgBox を 2 回表示するのでしょうか?

    '測定を開始するセル範囲(このセルは空欄で、その上のセルに値が入っている)
    Dim baseRange As Range
    Set baseRange = Range("A10:C10")
    
    '行番号の一覧を保持しておくための配列
    Dim rowNumbers() As Long
    ReDim rowNumbers(1 To baseRange.Areas(1).Count)
    
    'それぞれの End(xlUp).Row 値を行番号配列に代入
    Dim colIndex As Long, r As Range
    For colIndex = 1 To UBound(rowNumbers)
        rowNumbers(colIndex) = baseRange.Areas(1)(colIndex).Offset(-1, 0).End(xlUp).Row
    Next
    
    ' LARGE 関数を使って、2 番目に大きい値を取り出す
    ' 重複順位を許容しない場合や、重複時に次の順位をスキップしてカウントする場合は、LARGE 関数以外の方法を検討する
    Dim secondRow As Long
    secondRow = CLng(WorksheetFunction.Large(rowNumbers, WorksheetFunction.Min(2, UBound(rowNumbers))))
    
    ' 見つかった行番号位置のセル値を MsgBox に表示する
    ' 「2 番目に大きい値」が 1 件とは限らないので、念のためにループ処理している
    For colIndex = 1& To UBound(rowNumbers)
        If rowNumbers(colIndex) = secondRow Then
            Set r = Cells(secondRow, baseRange.Areas(1)(colIndex).Column)
            MsgBox "セル値=" & r.Text, vbInformation, "セル位置=" & r.Address(False, False, xlA1)
        End If
    Next
    2020年2月9日 10:51
  • ReDim rowNumbers(1 To baseRange.Areas(1).Count)
    このコードの意味を教えていただいてもいいでしょうか?

    Ctrl キーを押しながらマウス操作することで「非連続のセル領域」を選択することができるかと思いますが、その領域グループの1つ1つを示すものが Area です。

    たとえば Range("A3:E3,C1:C5,B2:D4").Select な選択範囲があったとすると
    Range("A3:E3,C1:C5,B2:D4").Areas.Count は 3 であり
    Range("A3:E3,C1:C5,B2:D4").Areas(1) は Range("A3:E3") 相当で
    Range("A3:E3,C1:C5,B2:D4").Areas(2) は Range("C1:E5") 相当で
    Range("A3:E3,C1:C5,B2:D4").Areas(3) は Range("B2:D4") 相当です。

    先のコードでは非連続セルは想定していません。仮に非連続な領域を基準セル範囲として指定した場合、 .Areas(1) というコードを使って先頭の矩形領域のみをターゲットとするようにしています。

    また、先のコードは「基準セルが動的に変更される想定」で記述した物ですが、もしも基準セルが A10:C10 固定である場合には、ReDim や WorksheetFunction.Min の処理は不要ですね。

    'A~C列の行番号を保持しておくための配列
    Dim rowNumbers(1 To 3) As Long
    
    'それぞれの End(xlUp).Row 値を行番号配列に代入
    rowNumbers(1) = Range("A9").End(xlUp).Row
    rowNumbers(2) = Range("B9").End(xlUp).Row
    rowNumbers(3) = Range("C9").End(xlUp).Row
    
    ' LARGE 関数を使って、2 番目に大きい行番号を調べる
    Dim rowIndex As Long
    rowIndex = CLng(WorksheetFunction.Large(rowNumbers, 2))
    
    ' その行番号の列を逆引き
    Dim colIndex As Integer
    For colIndex = 1 To 3
        If rowNumbers(colIndex) = rowIndex Then
            Exit For
        End If
    Next
    
    'セル値を表示
    MsgBox "セル値=" & Cells(rowIndex, colIndex).Text, vbInformation, "セル位置=" & Cells(rowIndex, colIndex).Address(False, False, xlA1)

    • 回答としてマーク ykaza 2020年2月12日 23:30
    2020年2月12日 0:44

すべての返信

  • セルA10 B10 C10それぞれから上に向かって空白の直前の行番号を抽出して、行番号が2番目に大きいセル

    もしも C3 セルが 3 ではなく空欄だった場合、
    行番号が2番目に大きい場所は B4 と C4 の 2 箇所ということになりますが、
    その場合は MsgBox を 2 回表示するのでしょうか?

    '測定を開始するセル範囲(このセルは空欄で、その上のセルに値が入っている)
    Dim baseRange As Range
    Set baseRange = Range("A10:C10")
    
    '行番号の一覧を保持しておくための配列
    Dim rowNumbers() As Long
    ReDim rowNumbers(1 To baseRange.Areas(1).Count)
    
    'それぞれの End(xlUp).Row 値を行番号配列に代入
    Dim colIndex As Long, r As Range
    For colIndex = 1 To UBound(rowNumbers)
        rowNumbers(colIndex) = baseRange.Areas(1)(colIndex).Offset(-1, 0).End(xlUp).Row
    Next
    
    ' LARGE 関数を使って、2 番目に大きい値を取り出す
    ' 重複順位を許容しない場合や、重複時に次の順位をスキップしてカウントする場合は、LARGE 関数以外の方法を検討する
    Dim secondRow As Long
    secondRow = CLng(WorksheetFunction.Large(rowNumbers, WorksheetFunction.Min(2, UBound(rowNumbers))))
    
    ' 見つかった行番号位置のセル値を MsgBox に表示する
    ' 「2 番目に大きい値」が 1 件とは限らないので、念のためにループ処理している
    For colIndex = 1& To UBound(rowNumbers)
        If rowNumbers(colIndex) = secondRow Then
            Set r = Cells(secondRow, baseRange.Areas(1)(colIndex).Column)
            MsgBox "セル値=" & r.Text, vbInformation, "セル位置=" & r.Address(False, False, xlA1)
        End If
    Next
    2020年2月9日 10:51
  • 魔界の仮面弁士 さん

    回答の方ありがとうございます!

    また返信が遅れてしまい失礼しました。

    >もしも C3 セルが 3 ではなく空欄だった場合、
    行番号が2番目に大きい場所は B4 と C4 の 2 箇所ということになりますが、
    その場合は MsgBox を 2 回表示するのでしょうか?

    行番号が2番目に大きい場所が被らないような作業内容なので大丈夫なのですが、被った場合の処理まで対応して下さってありがとうございます。
    イメージ通りの動作が確認できたのでおかげさまで作業がはかどります。

    またお時間があればでいいのですが、
    ReDim rowNumbers(1 To baseRange.Areas(1).Count)
    このコードの意味を教えていただいてもいいでしょうか?
    ReDimやAreasでググってもイマイチわからなかったためできれば今後の参考のためにお聞きしたいのですが。
    時間がなければスルーして頂いて構いません笑

    なんにせよ今回は回答していただいてありがとうございました。助かりました!

    • 回答としてマーク ykaza 2020年2月11日 1:31
    • 回答としてマークされていない ykaza 2020年2月11日 1:31
    2020年2月11日 1:31
  • ReDim rowNumbers(1 To baseRange.Areas(1).Count)
    このコードの意味を教えていただいてもいいでしょうか?

    Ctrl キーを押しながらマウス操作することで「非連続のセル領域」を選択することができるかと思いますが、その領域グループの1つ1つを示すものが Area です。

    たとえば Range("A3:E3,C1:C5,B2:D4").Select な選択範囲があったとすると
    Range("A3:E3,C1:C5,B2:D4").Areas.Count は 3 であり
    Range("A3:E3,C1:C5,B2:D4").Areas(1) は Range("A3:E3") 相当で
    Range("A3:E3,C1:C5,B2:D4").Areas(2) は Range("C1:E5") 相当で
    Range("A3:E3,C1:C5,B2:D4").Areas(3) は Range("B2:D4") 相当です。

    先のコードでは非連続セルは想定していません。仮に非連続な領域を基準セル範囲として指定した場合、 .Areas(1) というコードを使って先頭の矩形領域のみをターゲットとするようにしています。

    また、先のコードは「基準セルが動的に変更される想定」で記述した物ですが、もしも基準セルが A10:C10 固定である場合には、ReDim や WorksheetFunction.Min の処理は不要ですね。

    'A~C列の行番号を保持しておくための配列
    Dim rowNumbers(1 To 3) As Long
    
    'それぞれの End(xlUp).Row 値を行番号配列に代入
    rowNumbers(1) = Range("A9").End(xlUp).Row
    rowNumbers(2) = Range("B9").End(xlUp).Row
    rowNumbers(3) = Range("C9").End(xlUp).Row
    
    ' LARGE 関数を使って、2 番目に大きい行番号を調べる
    Dim rowIndex As Long
    rowIndex = CLng(WorksheetFunction.Large(rowNumbers, 2))
    
    ' その行番号の列を逆引き
    Dim colIndex As Integer
    For colIndex = 1 To 3
        If rowNumbers(colIndex) = rowIndex Then
            Exit For
        End If
    Next
    
    'セル値を表示
    MsgBox "セル値=" & Cells(rowIndex, colIndex).Text, vbInformation, "セル位置=" & Cells(rowIndex, colIndex).Address(False, False, xlA1)

    • 回答としてマーク ykaza 2020年2月12日 23:30
    2020年2月12日 0:44
  • 返信ありがとうございます。

    なるほど。基準セルが変更されても対応できるようなコードだったんですね。
    まだVBAは簡単な本を2冊ほど読んだだけの素人で見慣れないコードだったので少し混乱してしまいましたw

    ReDim や WorksheetFunction.Min がない場合のコードまで書いてくださってありがとうございます。
    おかげさまでこちらのコードはとても分かりやすくほぼ理解できたので、これを参考に元のコードも読み解こうと思います。

    今回はいろいろと解説までしていただきありがとうございました。とても助かりました!
    • 編集済み ykaza 2020年2月12日 23:32
    2020年2月12日 23:30
  • 基準セルが変更されても対応できるようなコードだったんですね。

    最初に提示頂いたコードが、Areas が 3 つの
    Range("A10, B10, C10") 表記になっていたのに、それを勝手に
    Range("A10:C10") 形式に置き換えたことへの配慮のつもりでした。

    コードが冗長的になって分かりにくくなってしまったようですみません。

    これを参考に元のコードも読み解こうと思います。

    最初の質問文に従って .End(xlUp).Row を用いたコードで組んでありますが、この方法だけだと、ワークシートの入力内容によっては正しく取得できないパターンがありえることに注意しておいてください。(具体的には、8 行目が空欄であったケース)

    たとえば『B4~A9全てに2』ではなく「B1~B8まで空、B9だけ2」のように
    9行目にしか値が無い場合は行番号として 9 が取得されるべきですが、
    9行目から .End(xlUp).Row する方法だと、行番号 1 が取得されることになります。

    それゆえに、運用ルールで8 行目が空欄とならないよう制限を加えておくか、もしくは上記に対処するための VBA コードを追加した方が良いかと思います。

    2020年2月13日 0:19
  • わざわざ.End(xlUp).Rowの注意点まで教えてくださってありがとうございます。
    たしかに空欄の位置によっては意図してない結果になってしまいますよね。
    アドバイス頂いた通り何かしら対策したコードにしようと思います。

    エクセルもVBAも実行結果が実際どうなるかイメージできてないとわけのわからない表示になるんですよねw
    出来上がってからコードの修正も大変なので教えていただいて助かります!

    2020年2月13日 11:01