VBAの勉強を始めてみた

色々試しています。

文字の冒頭に指定した文字を追加する

セルにあらかじめ入っている文字列(文字列以外でも可)の冒頭に、InputBoxで指定した文字を追加します。

 

f:id:kouten0430:20170805142238j:plain

実行前

 

f:id:kouten0430:20170805142303j:plain

実行後

 

選択したセル範囲(可視セルのみ)に対し、For Each Nextで下記の処理を行います。

オブジェクト.Value = 変数(InputBoxで入力された文字) & オブジェクト.Value

 

 

***************************************

Sub 冒頭に文字を追加する()
    Dim V As Variant
    Dim myRange As Range
   
    V = Application.InputBox(Prompt:="冒頭に追加する文字を入力して下さい", Type:=2)
        If TypeName(V) = "Boolean" Then
            Exit Sub
        End If
    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
        If myRange.Address = myRange.MergeArea(1).Address Then   '結合セルの場合は左上のセルのみ処理する
            myRange.Value = V & myRange.Value
        End If
    Next myRange

End Sub

***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

 

使用する際の注意
マクロで行った処理は「元に戻す」ことができない為、マクロ実行前に保存することをお勧めします。

 

末尾に文字を追加する場合はこちら 

kouten0430.hatenablog.com

 

文字の末尾に指定した文字を追加する

セルにあらかじめ入っている文字列(文字列以外でも可)の末尾に、InputBoxで指定し

た文字を追加します。

 

f:id:kouten0430:20170805140942j:plain

実行前

 

f:id:kouten0430:20170805141009j:plain

実行後

 

選択したセル範囲(可視セルのみ)に対し、For Each Nextで下記の処理を行います。

オブジェクト.Value = オブジェクト.Value & 変数(InputBoxで入力された文字)

 

 

***************************************

Sub 末尾に文字を追加する()
    Dim V As Variant
    Dim myRange As Range
   
    V = Application.InputBox(Prompt:="末尾に追加する文字を入力して下さい", Type:=2)
        If TypeName(V) = "Boolean" Then
            Exit Sub
        End If
    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
        If myRange.Address = myRange.MergeArea(1).Address Then   '結合セルの場合は左上のセルのみ処理する
            myRange.Value = myRange.Value & V
        End If
    Next myRange

End Sub
***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお

願いいたします。

 

使用する際の注意
マクロで行った処理は「元に戻す」ことができない為、マクロ実行前に保存することを

お勧めします。

 

冒頭に文字を追加する場合はこちら  

kouten0430.hatenablog.com

 

表をオリジナルの順番で並び替える

Sheet1に人口順に並んだ、47都道府県の表があります。この表を北から順番(北海道→青森→岩手・・・のように)に並べ替えるにはどうしたらいいでしょうか?
EXCELの標準機能では昇順・降順、あいうえお順、日付順、曜日順等で並べ替えることはできますが、人間のみが理解できるあいまいな順番で並び替えをすることはできません。
今回はそういう、昇順・降順でもなく、あいうえお順等でもない順番で表を並び替えるマクロを作ってみました。

 

f:id:kouten0430:20170802233450j:plain

例えばSheet1に人口順に並んだ、47都道府県の表があります。

これを、Sheet2のA列(都道府県が北から順番に並んでいる)を手本に、Sheet1の表全体を並び替えるには・・・・・・

 

f:id:kouten0430:20170802234130j:plain

f:id:kouten0430:20170802234313j:plain

A列の北海道から沖縄まで(列見出しの「都道府県」は除く)を選択して、前回のマクロ(選択範囲のデータをカンマ区切りでクリップボードに格納 )を実行して下さい。

 

f:id:kouten0430:20170802234636j:plain
このように、カンマで区切られた北海道から沖縄までのデータがクリップボードに格納されます。(セルを選択した順番でカンマ区切りで並びます)

 

f:id:kouten0430:20170802234832j:plain

次に、Sheet1の並び替えしたい範囲を選択(列見出しを除く)して、今回のマクロ(選択範囲をオリジナルの順番で並び替える)を実行して下さい。

 

f:id:kouten0430:20170802234923j:plain

これで、クリップボード内のデータを参照し、Sheet1の表が北海道~沖縄の順番で並び替わりました。

 

上記の例では都道府県名の列が左端でしたが、並び替えのキーとなる列が左端以外の場合も説明しときます。

 

f:id:kouten0430:20170802235138j:plain

f:id:kouten0430:20170802235215j:plain

並び替える範囲を選択した後、Tabキーでアクティブセル(白抜きとなっているセル)をキー列まで移動します。

 

f:id:kouten0430:20170802235327j:plain

クリップボードに並び替え用のデータが格納された状態で、先程と同じくマクロを実行すると、並び替えが完了します。

 

なお、上記と同じようなオリジナルでの並び替えが、EXCELのオプション-詳細設定-ユーザー設定リストの編集にてユーザー設定リストを追加することでもできますが・・・・・・ユーザー設定リストの編集で直接リスト入力やリストをインポートする場合に、下記エラーによってリスト化できないことがあります。

 

f:id:kouten0430:20170802235551j:plain

 

「ユーザー設定リストの最大長を超えています。最初の255文字のみ保存されます。」

 

f:id:kouten0430:20170803000210j:plain

 

 

「リストには、単純な文字列が入力されているセルだけが取り込まれます。」

しかし、上記のようなエラーでリスト化できない文字列でも、マクロであれば無関係にリスト化(クリップボード上で仮想リスト化)し、並び替えすることができます。

 

 

マクロを使用するには、事前にVBEからMicrosoft Forms 2.0 Object Libraryを参照設定する必要があります。
(ツール→参照設定→参照からWindows\System32\FM20.DLLを選択)

***************************************

Sub 選択範囲をオリジナルの順番で並び替える()
    'Microsoft Forms 2.0 Object Libraryを参照設定して下さい
    'あらかじめ、オリジナルの順番をカンマ区切りでクリップボードに格納しておいて下さい
    '範囲選択後、Tabキーでアクティブセル(白抜き)を並び替えのキーとなる列に移動して下さい
    Dim V As String
   
    Set Dobj = New DataObject
    With Dobj
        .GetFromClipboard
        On Error Resume Next
        V = .GetText
        On Error GoTo 0
    End With
   
    If V <> Empty Then
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=ActiveCell, CustomOrder:="""," & V & """"
            .SetRange Selection
            .Header = xlNo
            .Apply
        End With
    Else
        MsgBox "クリップボードにデータがありません!"
    End If
End Sub

***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

 

使用する際の注意
マクロで行った処理は「元に戻す」ことができない為、マクロ実行前に保存することをお勧めします。

 

クリップボード上に並び替え用の仮想リストを作成するマクロはこちら 

kouten0430.hatenablog.com

 

 

 

選択範囲のデータをカンマ区切りでクリップボードに格納する

選択したセル(複数選択可)の文字列を、カンマ区切りでクリップボードに格納します。選択したセルが結合セルでも、余分なTabや改行を含まず単一セルと同じような扱いでクリップボードに格納できます。
次回掲載予定のマクロと組み合わせて使用するためのものです。

下記のマクロを使用するには、事前にVBEからMicrosoft Forms 2.0 Object Libraryを参照設定する必要があります。
(ツール→参照設定→参照からWindows\System32\FM20.DLLを選択)


***************************************
Sub 選択範囲のデータをカンマ区切りでクリップボードに格納()
    'Microsoft Forms 2.0 Object Libraryを参照設定して下さい
   
    Dim myRange As Range
    Dim V As String

    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
        If myRange.Address = myRange.MergeArea(1).Address Then   '結合セルの場合は左上の値のみ取り出す
            V = V & myRange.Value & ","
        End If
    Next myRange
   
    V = Left(V, Len(V) - 1) '最終行のカンマ区切りを取り除く
   
    With New MSForms.DataObject
        .SetText V  '変数の値をDataObjectに格納する
        .PutInClipboard 'DataObjectのデータをクリップボードに格納する
    End With

End Sub
***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

ピボットテーブル用の元データに年度・四半期・月フィールドを作成する

ピボットテーブルを使用すると、大量のデータを様々な角度から集計できて便利なのですが・・・・・・、ピボットテーブルには何故か「年度」というグループ分け機能が搭載されていないため、年度ごとに集計を行う場合には非常に不便です。

 

f:id:kouten0430:20170724215428j:plain

例えば、集計や累計などは年単位で区切られるので1月~12月の集計・累計となり、次の1月1日からは新たな集計・累計の始まりとなります。(年度ごとの集計・累計にならない)
また、四半期ごとにグループ分けを行うと、1月が四半期の始まり(第1四半期)となるのも不便です。


これを解決する方法は、いくつかありますか、私はピボットテーブルの元データに年度・四半期・月フィールドを追加するのが一番手っ取り早いと思います(既に他の多くのサイト様でも同じように紹介されていますが・・・・・・)

 

f:id:kouten0430:20170724215953j:plain

年度・四半期・月フィールドは下記のような数式で作成できます。

年度フィールド
=IF(D2="","",IF(MONTH(D2)<=3,YEAR(D2)-1&"年度",YEAR(D2)&"年度"))

四半期フィールド
=IF(D2="","",IF(MONTH(D2)<=3,"第4四半期",IF(MONTH(D2)<=6,"第1四半期",IF(MONTH(D2)<=9,"第2四半期","第3四半期"))))

月フィールド
=IF(D2="","",MONTH(D2)&"月")

※D2の部分は相対参照によって異なります

 

f:id:kouten0430:20170724220325j:plain

そして、ピボットテーブルを作成する際、元の「日付」フィールドは使用せずに、新たに作成した「年度」「四半期」「月」フィールドを使用しましょう。

下記のようなピボットテーブルに生まれ変わります。

 

f:id:kouten0430:20170724220520j:plain

4月~3月を一つの年度とし、四半期の始まりが4月になります(集計も年度単位となっています)

 

しかーし!

ここまでは他のサイト様が紹介している内容とさほど変わりはなく、VBAの勉強を始めてみたを謳い文句にしている当ブログの名折れとなってしまうので、年度・四半期・月フィールドを瞬時に作成するコードを作成してみました。

 

f:id:kouten0430:20170724221849j:plain

ピボットテーブルの元データの日付フィールドの1セルを選択した状態でマクロを実行して下さい。

 

f:id:kouten0430:20170724222231j:plain

日付フィールドの左側に年度・四半期・月フィールドが自動作成されます。

 

***************************************

Sub ピボットテーブル用年度四半期月フィールド作成()
    '日付データが入ったフィールドの1セルを選択(どれでも良い)して実行
    Dim X As Long
    Dim YS As Long
    Dim YE As Long
   
    If TypeName(ActiveCell.Value) = "Date" Then
        X = ActiveCell.Column
        YS = ActiveCell.CurrentRegion.Row
        YE = ActiveCell.CurrentRegion.Rows(ActiveCell.CurrentRegion.Rows.Count).Row

        Range(Columns(ActiveCell.Column), Columns(ActiveCell.Column + 2)).Insert xlShiftToRight, _
        xlFormatFromLeftOrAbove
   
        Cells(YS, X).Value = "年度"
        Range(Cells(YS + 1, X), Cells(YE, X)).FormulaR1C1 = _
        "=IF(RC[3]="""","""",IF(MONTH(RC[3])<=3,YEAR(RC[3])-1&""年度"",YEAR(RC[3])&""年度""))"

        Cells(YS, X + 1).Value = "四半期"
        Range(Cells(YS + 1, X + 1), Cells(YE, X + 1)).FormulaR1C1 = _
        "=IF(RC[2]="""","""",IF(MONTH(RC[2])<=3,""第4四半期"",IF(MONTH(RC[2])<=6,""第1四半期"",IF(MONTH(RC[2])<=9,""第2四半期"",""第3四半期""))))"
   
        Cells(YS, X + 2).Value = "月"
        Range(Cells(YS + 1, X + 2), Cells(YE, X + 2)).FormulaR1C1 = _
        "=IF(RC[1]="""","""",MONTH(RC[1])&""月"")"
       
    Else
        MsgBox "日付データの入ったセルを選択して下さい"
       
    End If
End Sub

***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

マクロをクイックアクセスツールバーに登録する

今回はマクロをクイックアクセスツールバーに登録してみたいと思います。クイックアクセスツールバーを編集するには・・・・・・

 

f:id:kouten0430:20170720204546j:plain

リボンのタブ内で右クリックし「クイックアクセスツールバーのユーザー設定」を選択します。(ファイル-オプション-クイックアクセスツールバーのユーザー設定でも同様です)

クイックアクセスツールバーのユーザー設定画面を開いたら、

 

f:id:kouten0430:20170720204830j:plain

1.コマンドの選択で「マクロ」を選びます
2.現在開いているブックや個人用マクロブックに登録されているマクロが一覧表示されるので、必要なものを選択し「追加」を押します。すべてのドキュメントに適用(既定)欄にマクロが追加されるので、これを必要なだけ繰り返します。
3.マクロの追加が終わったら、OKを押して設定を終了します。

 

f:id:kouten0430:20170720205145j:plain

クイックアクセスツールバーに登録したマクロが表示されます。

・・・・・・が、どれが何のマクロか分かりにくい為、使用頻度の高いもののみ2~3個の登録に留めるのが良いかと個人的には思います。

マクロをリボンに登録する

今回はマクロをリボンに登録してみたいと思います。リボンを編集するには・・・・・・

 

f:id:kouten0430:20170717150841j:plain

リボンのタブ内のどこでもいいので右クリックして「リボンのユーザー設定」をクリックします。(ファイル-オプション-リボンのユーザー設定からでも同じように入れます)

リボンのユーザー設定画面を開いたら、

 

f:id:kouten0430:20170717151005j:plain

1.メインタブを選択します
2.新しいタブを作成(今回は名前を「マクロ」とします)
3.新しいグループを作成
4.コマンドの選択で「マクロ」を選びます
5.現在開いているブックや個人用マクロブックに登録されているマクロが一覧表示されますので、必要なものを選んで「追加」を押します。新しいグループ(ユーザー設定)にマクロが追加されるので、これを必要なだけ繰り返します。
6.マクロの追加が終わったら、OKを押して設定を終了します。

 

f:id:kouten0430:20170717151217j:plain

マクロというタブが追加され、その中に追加したマクロのボタンがズラリと並んでいます。
・・・・・・が、個人用マクロブックから登録したものはPERSONAL.XLSB!○○○という長ったらしい名前が表示されるため、このままではとても見づらいです。なので、分かりやすい名前に変更したいと思います。

再度、リボンのユーザー設定画面を開き

 

f:id:kouten0430:20170717151314j:plain

1.登録したマクロを選択し
2.「名前の変更」をクリックします。
3.自分が分かりやすい名前に変更しましょう。お好みでアイコンも変更できます(私は変更しない派です)

 

f:id:kouten0430:20170717151400j:plain

4.名前の変更がすべて終わったら、OKをクリックして設定を終了します。

 

f:id:kouten0430:20170717151148j:plain

これで、かなり見やすくなったと思うのですが、どうでしょうか?

 

次回はクイックアクセスツールバーへマクロを登録してみたいと思います。