説明を書いているうちに、前回説明を繰り越した子マクロの追加は、式コピー・式貼付をバージョンアップする際に、発想・手法を大きく変えたものであったことを、思い出した。

長いマクロを作っている時は、作るのに手一杯でコメント記載を怠ると後で分からなりがち。
例え、コメントを書いても「何だっけ?」となるかもしれないが、無いよりは100倍助かる筈(for 記憶容量が無限でない限り?!)。

ver9では子マクロは更に、以下の三つを新たに導入。
kcr_行数一時表記追加_ver9(k)
kcr_行表示取り出しマクロ_ver9(k)
kcr_行数表記削除_ver9()

上の二つは引数付きのSubブロシージャで、最後の一つは引数を持たせずにFunctionプロシージャにすることで、マクロのダイアログボックスに表示させないようにしている。特に返り値を使用しているわけではない。
また、上記の子マクロに差し替えられて、廃版になったSub kcr_セル値_Ω_列表記貼付_ver8() も参考までに再掲した。
登場する子マクロ毎に説明していく。

最初の kcr_行数一時表記追加_ver9 は、Sumifs関数の合計列・条件列を指定するセルデータに、所定のセルに入力されているLAND選択等の選択範囲の行データを元に、行データを付加するマクロになる。
この子マクロが呼び出される時は、Sumifs関数の列指定をする行、Suimfs関数入力サポートマクロを実行時とLAND選択の1行上、表示
((例) $G:$G を $G5:$G12 にするなど)
変数・データ型の宣言の直後に「kcr_行表示取り出しマクロ_ver9」を呼び出している。このマクロは「kcr_行数一時表記追加_ver9」のメイン処理の前に、所定のセルに入っている行範囲を含むLAND選択の表記「$G$12:$L$20」などのテキストデータ(※)を一時的に列表記のテキスト文から、$とアルファベットを置換処理により削除(排除といった方が適切?)し、「12Ω20」というデータに変更する。
(※ 実際の作業としては「式コピー・セル1複数セル選択」を式貼付で、入力したものを利用することを想定)

Sub kcr_行数一時表記追加_ver9(k)
Dim j As Integer, i As Integer
Dim MH(10) As String
Dim C_Moji As String, K_Moji As String

    Call kcr_行表示取り出しマクロ_ver9(0)
    C_Moji = ActiveCell
    K_Moji = "Ω"

'行表示取り出しマクロで数字がΩで区切られている
'テキストデータを変数 C_Moji に代入。Ω も K_Moji に
'代入する。

    If C_Moji = "" Then
        Exit Sub
    End If
'C_Moji が空文字なら、処理を終了する。
'ΩがC_Moji の何文字目になるかをImStr関数を
'使い特定し、変数 i に代入する。

    i = InStr(1, C_Moji, K_Moji)
    MH(0) = Left(C_Moji, i - 1)
    MH(1) = Mid(C_Moji, i + 1, Len(C_Moji) - i)

'Ωの前後の数字を取り出し配列MH(0)とMH(1)に代入。

    R = ActiveCell.Row
    C = ActiveCell.Column

'この子マクロが呼び出される時は、Sumifs関数の列表示を
'指定するセル、 rngcell(前回125号参照)がアクティブと
'なっている。
'このアクティブセルから右側にはSumifs関数の合計列を
'指定するセルと条件列を指定するセルである。以下の 
'For ~ Next で 列全体を示す範囲表記を行範囲を特定する
'数字(MH(0) と MH(1) に格納された数字データ)が
'記載された一列のセル範囲の表記に変更される、

    For j = 1 To ActiveCell.CurrentRegion.Columns.Count
        C_Moji = Cells(R, C + j)
        K_Moji = ":"

        i = InStr(1, C_Moji, K_Moji)
        MH(j + 1) = Left(C_Moji, i - 1) & "$" & MH(0) & ":" & _
              Mid(C_Moji, i + 1, Len(C_Moji) - i) & "$" & MH(1)

        Cells(R, C + j) = MH(j + 1)
        '下記のIf文は、万が一、Sumifs関数の合計列と
  '条件列を指定するセルが空白となっている場合を
  '想定して、エラーとならないために記載したが、
  '本来、空白となっていない状態で式貼付を使用する
  '前提であり、前提を守り使用すれば不要のマクロ文と
  'なる。
        If Len(Cells(R, C + j + 1)) = 0 Then
            Exit For
        End If
    Next

End Sub

Sub kcr_行表示取り出しマクロ_ver9(k)
Dim i As Integer 

'行表示取り出しマクロでは、rngcell「$G5:$G12など
'のように記載されている範囲表記のデータを5Ω12
'書式のデータに変更する

'「:」を「Ω」に置換
Application.ScreenUpdating = False
    ActiveCell.Replace What:=":",  _
       Replacement:="Ω", LookAt:=xlPart
'「$」を「」(空文字)に置換
    ActiveCell.Replace What:="$", _
        Replacement:="", LookAt:=xlPart

'「Chr(65) ~ Chr(65)  」は大文字のアルファベット
'「A ~ Z 」で、大文字のアルファベットを「」(空文字)
'に置換
    For i = 65 To 91
        ActiveCell.Replace What:=Chr(i), _
          Replacement:="", LookAt:=xlPart
    Next

'以下は、画面表記を更新するためのマクロ文
   Application.MoveAfterReturn = False
   Application.MoveAfterReturn = True
End Sub

Function kcr_行数表記削除_ver9()
Dim sln As Object
Dim cell As Range
'このマクロはSumifs関数の合計列、条件列の指定する
'セルが行数指定する書式に一時的に変えた場合に
'Sumifs関数の入力を終えた後に、元に戻す処理を行う。
'実行時にはSumifs関数の合計列、条件列の指定するセルが
'選択されており、これを sln に設定する。
    Set sln = Selection

'slnのセルズ1のセルのデータをtxt_bfrに代入する。
    txt_bfr = sln.Cells(1) 

'行数指定する書式となっているslnの各セルのデータから
'数字の文字データ「0、1、2、・・、8、9」を置換処理に
'より削除。Chr(48) ~ Chr(58) は数字の文字。
    For i = 49 To 58
        sln.Replace What:=Chr(i - 1), Replacement:="", _
          LookAt:=xlPart
    Next
'slnのセルズ1のセルのデータをtxt_afrに代入する。
    txt_aft = sln.Cells(1)

'txt_bfr と txt_afr が違うこと(数字が削除することで
'変わっているか、言い方を変えると、削除処理前に
'数字が含まれているか)を確認した上で、置換処理を
'実行するか、処理を分岐している
'これはこのマクロを行指定のされていない列表記に対して
'使用した場合はデータが変わらない様にするための配慮。
'Sumifs関数入力サポートのマクロを使用直後は、
'Sumifs関数の合計列、条件列の指定するセルは、行指定を
'している場合は、同マクロを使用前の行指定がされて
'いない状態とは違っている。
'同じ状態に戻したい場合は、合計列、条件列の指定する
'セルを選択し、本「kcr_行数表記削除_ver9」を実行すれば
'簡単に戻すことができるが、誤って既に行表示がない
'状態で実行してもデータを壊すことがないようにしている
'ものである。

    If txt_bfr <> txt_aft Then
'先の置換処理で「 $: 」となっている文字列を「 : 」に
'更に置換する。
        sln.Replace What:="$:", Replacement:=":", _
          LookAt:=xlPart
'先の置換処理で文字列の文末が「 $: 」となっているので
'取り除く処理をする。 
'「式貼付・セルズ4以上 」の実行に続いて、
'「Sumifs集計表入力サポートマクロ」(次回説明予定)を
' 実行した場合、合計列、条件列の指定するセルからは
' 数字データは削除される仕様にしてある。
 
      For Each cell In sln
          cell = Left(cell, Len(cell) - 1)
      Next
 End If

'以下は、画面表記を更新するためのマクロ文
   Application.MoveAfterReturn = False
   Application.MoveAfterReturn = True
End Function

【ver8時代の行表示取り出しマクロ】
以前は行表示を取り出すために、行指定の入力セルの下の二つのセルに一時的に式を入力していたが、ver9では上記の「kcr_行表示取り出しマクロ_ver9」を使い、置換処理で行うことにして、
下のセルへの一時的な入力はしない仕様になっている。

Sub kcr_セル値_Ω_列表記貼付_ver8() 

 Dim Cp_adrs As String

 Dim C As Integer

 Dim cell1 As Range, cell2 As Range

 Cp_adrs = Selection.Cells(1).Address

 

 Set cell = Range(Cp_adrs) 

 Set cell1 = Range(Cp_adrs).Offset(-1, 0)

 Set cell2 = Range(Cp_adrs).Offset(-2, 0)

  Range(Cp_adrs) = P_Siki

 

  If cell.Row > 2 Then

   If Len(cell1 & cell2) <> 0 Then

    Call Mssg_式貼付_ver8(31)                     

    Exit Sub

   End If

   

   cell1.FormulaR1C1 = _

    "=MID(R[1]C,FIND(""Ω"",R[1]C,1)+2," & _

     "LEN(R[1]C)-FIND(""Ω"",R[1]C,1)-1)"


    cell2.FormulaR1C1 = _

    "=MID(R[2]C,1,FIND(""Ω"",R[2]C,1)-2)"

   

  cell1 = cell1  '式を値に変更

  cell2 = cell2  '式を値に変更

 

  cell.ClearContents

  cell.Select

 

 Else

  Call Mssg_式張付_ver8(32)

 

 End If

End Sub


次回は、Sumifs関数を使った集計表作成をサポートするマクロの説明。

つづく

©2017 みさき式エクセルマクロ

あなたもスタンプをGETしよう
AD