左からn文字目の後ろに改行を入れる

左から数えてn文字目の後ろに改行を入れます。
対象となるセルを選択した状態でマクロを実行して下さい。

試しに「5」を指定してみます。

左から数えて5文字目の後ろに改行が入りました。

複数のセルの特定の位置に改行を入れたいけど、対象となるセルが多すぎて一つ一つ手作業でなんてやってらんないよー！という場面があればきっと役にたつと思います。
そういう場面がなければ無用の長物です。さらりと読み流して下さい。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub 左からn文字目の後ろに改行を入れる()
    '左から数えてn文字目の後ろにセル内改行を入れます
    Dim myRange As Range
    Dim ns As Variant
   
    ns = Application.InputBox(Prompt:="左から何文字目の後ろに改行を入れますか？", Type:=1)
        If TypeName(ns) = "Boolean" Then
            Exit Sub
        End If
   
    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)
        If myRange.Value <> "" And TypeName(myRange.Value) <> "Date" Then   'セルの値が空白,日付の場合は処理をしない
            myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, ns + 1, 0, vbLf)
        End If
    Next myRange
   
End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

 ※SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存し

やり直しのできる状態にしておいて下さい。

小数第n位以下を四捨五入する

小数点n位以下を四捨五入したいセルを選択して、マクロを実行します。

InputBoxに四捨五入したい小数点以下の桁数を指定します。例えば、小数第三位以下を四捨五入する場合は「3」を入力します。

これで小数第三位以下が四捨五入され、小数第二位までの数値に変換されます。ポイントは表示上だけではなく、実際に四捨五入された数値になることです。

「小数点以下の表示桁数を減らす」ボタンや「書式設定－表示形式－小数点以下の桁数指定」で行った場合は、表示のみの変化であるため内部的には小数点以下がすべてそのまま残ります。SUM関数などで合計した際に、見えない部分の小数の桁上がりによって、表示上の合計と異なってしまわないようにROUND関数やINT関数などで数値を整えましょう。
（印刷されたものが正式な書類として出回ってしまうと、「実はEXCEL上では小数n位以下が隠れていて･･････」というような言い訳は通用しません(。´Д⊂)）

ROUND関数を使った簡単なプログラムです。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub 小数第n位以下を四捨五入()
    Dim n As Variant
    Dim myRange As Range
    n = Application.InputBox(Prompt:="小数第何位以下を四捨五入しますか？", Type:=1)
        If TypeName(n) = "Boolean" Then
            Exit Sub
        End If
    For Each myRange In Selection
        If myRange.Value <> 0 And myRange.Value <> "" And _
        TypeName(myRange.Value) <> "String" And TypeName(myRange.Value) <> "Date" Then
        'セルの値が0,空白,文字列,日付のいづれかの場合は処理をしない
            myRange.Value = Round(myRange.Value, n - 1)  '小数第n位以下は四捨五入
        End If
    Next myRange
   
End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

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

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

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

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

実行前

実行後

選択したセル範囲（可視セルのみ）に対し、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で指定し

た文字を追加します。

実行前

実行後

選択したセル範囲（可視セルのみ）に対し、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の標準機能では昇順・降順、あいうえお順、日付順、曜日順等で並べ替えることはできますが、人間のみが理解できるあいまいな順番で並び替えをすることはできません。
今回はそういう、昇順・降順でもなく、あいうえお順等でもない順番で表を並び替えるマクロを作ってみました。

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

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

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

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

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

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

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

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

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

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

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

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

しかし、上記のようなエラーでリスト化できない文字列でも、マクロであれば無関係にリスト化（ｸﾘｯﾌﾟﾎﾞｰﾄﾞ上で仮想ﾘｽﾄ化）し、並び替えすることができます。

マクロを使用するには、事前に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までをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

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

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

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

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

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

年度フィールド
=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の部分は相対参照によって異なります

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

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

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

しかーし！

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

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

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

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub ピボットテーブル用年度四半期月フィールド作成()
    '日付データが入ったフィールドの１セルを選択（どれでも良い）して実行
    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までをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。