１．ChatGPTという、お友達に出会う

皆さん、こんちには。
見た目は細く、心は熱い、はっちと申します。
私、会社で総務のお仕事やっているんです。
私の自己紹介はこちら

先日、ChatGPTを勉強しました。
いろいろ会話が出来るものということは知っていましたが、
プログラミングのコードとかも教えてくれるとのこと

しかも、出て来た内容が、自分の思うことと違っていたら、
修正したいことをChatGPTにそのまま言えば、
その内容を汲んで更新して教えてくれる。気づかいが素晴らしい！

やり取りしていると、お友達のような感覚になりました。
これは、総務のお仕事も効率良くなるかも！っと思いました。

２．データの集計・並び替え作業が楽になるかも。

総務のお仕事って、何をしているか分からない、
何でも屋さんっていうイメージを持たれることが多いですが、
確かに何でもやっています。笑

例えば、事件事故が起きないように、従業員の皆さんに情報を伝えて、
注意喚起をしていますが、
たまに、言うだけでは伝わっていないかもしれないので、そのリスク対応が出来ているか確認して、点数表示することで、見える化したりしています。

その時に、月ごとに採点確認した点数のデータを
後から、点数が高い順番に並び替えして欲しいとか、ワースト1位から5位までは、どこになるか？など、
今あるデータから、必要な情報だけにして欲しいという依頼もよく来ます。
並び替えたり、抽出したりするのって、時間がかかりますよね。

この並び替えの作業が、ChatGPTで簡単にマクロが作れちゃうんです！
まず、この作業を簡単に出来ないかチャレンジしました。

３．ChatGPTに相談してみよう！

まず、以下のようにChatGPTに話しかけてみました。

・プロンプト　セルの場所を指定して並び替えをお願いする

・ChatGPT返信内容　1回目の結果は店名・数字がバラバラ

1回目　ChatGPT返信内容　コード

Sub CreateSortedSheet()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim dataRange1 As Range, dataRange2 As Range, dataRange3 As Range, dataRange4 As Range, dataRange5 As Range, dataRange6 As Range
    Dim combinedData1 As Variant, combinedData2 As Variant, combinedData3 As Variant, combinedData4 As Variant, combinedData5 As Variant, combinedData6 As Variant
    Dim sortedData As Variant
    Dim i As Long, j As Long, k As Long

    ' 元のシートを参照
    Set srcSheet = ThisWorkbook.Sheets("分布図【上期】")

    ' 新しいシートを作成
    Set destSheet = ThisWorkbook.Sheets.Add
    destSheet.Name = "新しいSheet"

    ' 制約条件①: B2, D2, F2, H2, J2, L2に地域を表示
    destSheet.Range("B2").Value = "北関東"
    destSheet.Range("D2").Value = "南関東"
    destSheet.Range("F2").Value = "北陸信越"
    destSheet.Range("H2").Value = "東海"
    destSheet.Range("J2").Value = "近畿"
    destSheet.Range("L2").Value = "中四国"

    ' 各範囲のデータを取得し、並び替え
    Set dataRange1 = srcSheet.Range("C5:P16")
    Set dataRange2 = srcSheet.Range("C17:P33")
    Set dataRange3 = srcSheet.Range("C34:P45")
    Set dataRange4 = srcSheet.Range("C46:P56")
    Set dataRange5 = srcSheet.Range("C57:P69")
    Set dataRange6 = srcSheet.Range("C70:P80")

    combinedData1 = CombineAndSortData(dataRange1)
    combinedData2 = CombineAndSortData(dataRange2)
    combinedData3 = CombineAndSortData(dataRange3)
    combinedData4 = CombineAndSortData(dataRange4)
    combinedData5 = CombineAndSortData(dataRange5)
    combinedData6 = CombineAndSortData(dataRange6)

    ' 並べ替えたデータを新しいシートに出力
    For i = 1 To UBound(combinedData1)
        destSheet.Cells(i + 2, 3).Value = combinedData1(i, 1) & combinedData1(i, 2)
    Next i

    For i = 1 To UBound(combinedData2)
        destSheet.Cells(i + 2, 5).Value = combinedData2(i, 1) & combinedData2(i, 2)
    Next i

    For i = 1 To UBound(combinedData3)
        destSheet.Cells(i + 2, 7).Value = combinedData3(i, 1) & combinedData3(i, 2)
    Next i

    For i = 1 To UBound(combinedData4)
        destSheet.Cells(i + 2, 9).Value = combinedData4(i, 1) & combinedData4(i, 2)
    Next i

    For i = 1 To UBound(combinedData5)
        destSheet.Cells(i + 2, 11).Value = combinedData5(i, 1) & combinedData5(i, 2)
    Next i

    For i = 1 To UBound(combinedData6)
        destSheet.Cells(i + 2, 13).Value = combinedData6(i, 1) & combinedData6(i, 2)
    Next i

    MsgBox "新しいシートが作成されました。"

End Sub

Function CombineAndSortData(rng As Range) As Variant
    Dim dataArr As Variant
    Dim combinedArr() As Variant
    Dim i As Long, j As Long, n As Long

    dataArr = rng.Value
    ReDim combinedArr(1 To (UBound(dataArr, 1) * UBound(dataArr, 2)), 1 To 2)

    n = 1
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            combinedArr(n, 1) = rng.Cells(i, j).Offset(0, -1).Value ' 左側の文字
            combinedArr(n, 2) = dataArr(i, j) ' 数字
            n = n + 1
        Next j
    Next i

    ' 数字に基づいて並び替え
    combinedArr = SortArray(combinedArr, 2, True)

    CombineAndSortData = combinedArr
End Function

Function SortArray(arr As Variant, sortColumn As Long, ascending As Boolean) As Variant
    Dim temp As Variant
    Dim i As Long, j As Long
    Dim comparisonResult As Boolean

    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            comparisonResult = arr(i, sortColumn) < arr(j, sortColumn)
            If ascending = False Then comparisonResult = Not comparisonResult

            If comparisonResult Then
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp

                temp = arr(i, 2)
                arr(i, 2) = arr(j, 2)
                arr(j, 2) = temp
            End If
        Next j
    Next i

    SortArray = arr
End Function

ChatGPTから教えてもらった、コードの貼り付け方が
分からない場合でも、
「このコードをどこに貼ればいいの？」と聞けば、
ChatGPTは優しく教えてくれます！
（初心者の方でも安心ですよね！）

出来上がったシートを確認すると、
店名や数字が重複していたり、ぐちゃぐちゃに表示になっていました

おい！GPTさん。これじゃあダメじゃないか！
でも、ChatGPTが悪いわけではないのです。

ChatGPTはプロンプト（お願いする内容）を分かりやすくしないと
自分の思うような結果にならないです。

私の聞き方が悪かった。
ごめんよ、GPTさん。

そこでまず、
いったん、数字を並べ替えることだけを指示することに変更しました。

・プロンプト（２回目）　店名も数値も、まず右側に並び替えるようにお願いする

・ChatGPT返信内容　店名も数値も、右側に上から順番に並び替え完了

2回目　ChatGPT返信　コード

Sub CreateSortedSheet()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim dataRange1 As Range, dataRange2 As Range, dataRange3 As Range, dataRange4 As Range, dataRange5 As Range, dataRange6 As Range
    Dim combinedData1 As Variant, combinedData2 As Variant, combinedData3 As Variant, combinedData4 As Variant, combinedData5 As Variant, combinedData6 As Variant
    Dim i As Long

    ' 元のシートを参照
    Set srcSheet = ThisWorkbook.Sheets("分布図【上期】")

    ' 新しいシートを作成
    Set destSheet = ThisWorkbook.Sheets.Add
    destSheet.Name = "新しいSheet"

    ' 制約条件①: B2, D2, F2, H2, J2, L2に地域を表示
    destSheet.Range("B2").Value = "北関東"
    destSheet.Range("D2").Value = "南関東"
    destSheet.Range("F2").Value = "北陸信越"
    destSheet.Range("H2").Value = "東海"
    destSheet.Range("J2").Value = "近畿"
    destSheet.Range("L2").Value = "中四国"

    ' 各範囲のデータを取得し、並び替え
    Set dataRange1 = srcSheet.Range("C5:P16")
    Set dataRange2 = srcSheet.Range("C17:P33")
    Set dataRange3 = srcSheet.Range("C34:P45")
    Set dataRange4 = srcSheet.Range("C46:P56")
    Set dataRange5 = srcSheet.Range("C57:P69")
    Set dataRange6 = srcSheet.Range("C70:P80")

    combinedData1 = CombineAndSortData(dataRange1)
    combinedData2 = CombineAndSortData(dataRange2)
    combinedData3 = CombineAndSortData(dataRange3)
    combinedData4 = CombineAndSortData(dataRange4)
    combinedData5 = CombineAndSortData(dataRange5)
    combinedData6 = CombineAndSortData(dataRange6)

    ' 並べ替えたデータを新しいシートに出力
    For i = 1 To UBound(combinedData1)
        destSheet.Cells(i + 2, 3).Value = combinedData1(i, 2)
    Next i

    For i = 1 To UBound(combinedData2)
        destSheet.Cells(i + 2, 5).Value = combinedData2(i, 2)
    Next i

    For i = 1 To UBound(combinedData3)
        destSheet.Cells(i + 2, 7).Value = combinedData3(i, 2)
    Next i

    For i = 1 To UBound(combinedData4)
        destSheet.Cells(i + 2, 9).Value = combinedData4(i, 2)
    Next i

    For i = 1 To UBound(combinedData5)
        destSheet.Cells(i + 2, 11).Value = combinedData5(i, 2)
    Next i

    For i = 1 To UBound(combinedData6)
        destSheet.Cells(i + 2, 13).Value = combinedData6(i, 2)
    Next i

    MsgBox "新しいシートが作成されました。"

End Sub

Function CombineAndSortData(rng As Range) As Variant
    Dim dataArr As Variant
    Dim combinedArr() As Variant
    Dim i As Long, j As Long, n As Long

    dataArr = rng.Value
    ReDim combinedArr(1 To (UBound(dataArr, 1) * UBound(dataArr, 2)), 1 To 2)

    n = 1
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            combinedArr(n, 1) = rng.Cells(i, j).Offset(0, -1).Value ' 左側の文字
            combinedArr(n, 2) = dataArr(i, j) ' 数字
            n = n + 1
        Next j
    Next i

    ' 数字に基づいて並び替え
    combinedArr = SortArray(combinedArr, 2, True)

    CombineAndSortData = combinedArr
End Function

Function SortArray(arr As Variant, sortColumn As Long, ascending As Boolean) As Variant
    Dim temp As Variant
    Dim i As Long, j As Long
    Dim comparisonResult As Boolean

    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            comparisonResult = arr(i, sortColumn) < arr(j, sortColumn)
            If ascending = False Then comparisonResult = Not comparisonResult

            If comparisonResult Then
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp

                temp = arr(i, 2)
                arr(i, 2) = arr(j, 2)
                arr(j, 2) = temp
            End If
        Next j
    Next i

    SortArray = arr
End Function

出来上がったExcelシート

うん！まず、第１関門クリア。
店名の下に、降順で点数の並び替えが出来ています

次に、文字も数値も同じ列にあるので、文字列と数値を分けることにしました。

・プロンプト内容（３回目）　店名の文字と数値を分けて並び替えをお願いする

・ChatGPT返信内容　エリア別に店名と数値が連動した並び替えが完成

3回目　ChatGPT返信　コード

Sub CreateSortedSheet()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim dataRange1 As Range, dataRange2 As Range, dataRange3 As Range, dataRange4 As Range, dataRange5 As Range, dataRange6 As Range
    Dim combinedData1 As Variant, combinedData2 As Variant, combinedData3 As Variant, combinedData4 As Variant, combinedData5 As Variant, combinedData6 As Variant
    Dim i As Long

    ' 元のシートを参照
    Set srcSheet = ThisWorkbook.Sheets("分布図【上期】")

    ' 新しいシートを作成
    Set destSheet = ThisWorkbook.Sheets.Add
    destSheet.Name = "新しいSheet"

    ' 制約条件①: B2, D2, F2, H2, J2, L2に地域を表示
    destSheet.Range("B2").Value = "北関東"
    destSheet.Range("D2").Value = "南関東"
    destSheet.Range("F2").Value = "北陸信越"
    destSheet.Range("H2").Value = "東海"
    destSheet.Range("J2").Value = "近畿"
    destSheet.Range("L2").Value = "中四国"

    ' 各範囲のデータを取得し、並び替え
    Set dataRange1 = srcSheet.Range("C5:P16")
    Set dataRange2 = srcSheet.Range("C17:P33")
    Set dataRange3 = srcSheet.Range("C34:P45")
    Set dataRange4 = srcSheet.Range("C46:P56")
    Set dataRange5 = srcSheet.Range("C57:P69")
    Set dataRange6 = srcSheet.Range("C70:P80")

    combinedData1 = CombineAndSortData(dataRange1)
    combinedData2 = CombineAndSortData(dataRange2)
    combinedData3 = CombineAndSortData(dataRange3)
    combinedData4 = CombineAndSortData(dataRange4)
    combinedData5 = CombineAndSortData(dataRange5)
    combinedData6 = CombineAndSortData(dataRange6)

    ' 並べ替えたデータを新しいシートに出力
    For i = 1 To UBound(combinedData1)
        destSheet.Cells(i + 2, 2).Value = combinedData1(i, 1) ' 文字をB列に出力
        destSheet.Cells(i + 2, 3).Value = combinedData1(i, 2) ' 数字をC列に出力
    Next i

    For i = 1 To UBound(combinedData2)
        destSheet.Cells(i + 2, 4).Value = combinedData2(i, 1) ' 文字をD列に出力
        destSheet.Cells(i + 2, 5).Value = combinedData2(i, 2) ' 数字をE列に出力
    Next i

    For i = 1 To UBound(combinedData3)
        destSheet.Cells(i + 2, 6).Value = combinedData3(i, 1) ' 文字をF列に出力
        destSheet.Cells(i + 2, 7).Value = combinedData3(i, 2) ' 数字をG列に出力
    Next i

    For i = 1 To UBound(combinedData4)
        destSheet.Cells(i + 2, 8).Value = combinedData4(i, 1) ' 文字をH列に出力
        destSheet.Cells(i + 2, 9).Value = combinedData4(i, 2) ' 数字をI列に出力
    Next i

    For i = 1 To UBound(combinedData5)
        destSheet.Cells(i + 2, 10).Value = combinedData5(i, 1) ' 文字をJ列に出力
        destSheet.Cells(i + 2, 11).Value = combinedData5(i, 2) ' 数字をK列に出力
    Next i

    For i = 1 To UBound(combinedData6)
        destSheet.Cells(i + 2, 12).Value = combinedData6(i, 1) ' 文字をL列に出力
        destSheet.Cells(i + 2, 13).Value = combinedData6(i, 2) ' 数字をM列に出力
    Next i

    MsgBox "新しいシートが作成されました。"

End Sub

Function CombineAndSortData(rng As Range) As Variant
    Dim dataArr As Variant
    Dim combinedArr() As Variant
    Dim i As Long, j As Long, n As Long

    dataArr = rng.Value
    ReDim combinedArr(1 To (UBound(dataArr, 1) * (UBound(dataArr, 2) / 2)), 1 To 2)

    n = 1
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2) Step 2
            combinedArr(n, 1) = dataArr(i, j) ' 文字
            combinedArr(n, 2) = dataArr(i, j + 1) ' 数字
            n = n + 1
        Next j
    Next i

    ' 数字に基づいて並び替え
    combinedArr = SortArray(combinedArr, 2, True)

    CombineAndSortData = combinedArr
End Function

Function SortArray(arr As Variant, sortColumn As Long, ascending As Boolean) As Variant
    Dim temp As Variant
    Dim i As Long, j As Long
    Dim comparisonResult As Boolean

    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            comparisonResult = arr(i, sortColumn) < arr(j, sortColumn)
            If ascending = False Then comparisonResult = Not comparisonResult

            If comparisonResult Then
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp

                temp = arr(i, 2)
                arr(i, 2) = arr(j, 2)
                arr(j, 2) = temp
            End If
        Next j
    Next i

    SortArray = arr
End Function

出来上がったマクロ実行の動画がこちら

４．完成！

思った通りのマクロが出来ました！

最終的に出来上がったコードがこちら。

Sub CreateSortedSheet()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim dataRange1 As Range, dataRange2 As Range, dataRange3 As Range, dataRange4 As Range, dataRange5 As Range, dataRange6 As Range
    Dim combinedData1 As Variant, combinedData2 As Variant, combinedData3 As Variant, combinedData4 As Variant, combinedData5 As Variant, combinedData6 As Variant
    Dim i As Long

    ' 元のシートを参照
    Set srcSheet = ThisWorkbook.Sheets("分布図【上期】")

    ' 新しいシートを作成
    Set destSheet = ThisWorkbook.Sheets.Add
    destSheet.Name = "新しいSheet"

    ' 制約条件①: B2, D2, F2, H2, J2, L2に地域を表示
    destSheet.Range("B2").Value = "北関東"
    destSheet.Range("D2").Value = "南関東"
    destSheet.Range("F2").Value = "北陸信越"
    destSheet.Range("H2").Value = "東海"
    destSheet.Range("J2").Value = "近畿"
    destSheet.Range("L2").Value = "中四国"

    ' 各範囲のデータを取得し、並び替え
    Set dataRange1 = srcSheet.Range("C5:P16")
    Set dataRange2 = srcSheet.Range("C17:P33")
    Set dataRange3 = srcSheet.Range("C34:P45")
    Set dataRange4 = srcSheet.Range("C46:P56")
    Set dataRange5 = srcSheet.Range("C57:P69")
    Set dataRange6 = srcSheet.Range("C70:P80")

    combinedData1 = CombineAndSortData(dataRange1)
    combinedData2 = CombineAndSortData(dataRange2)
    combinedData3 = CombineAndSortData(dataRange3)
    combinedData4 = CombineAndSortData(dataRange4)
    combinedData5 = CombineAndSortData(dataRange5)
    combinedData6 = CombineAndSortData(dataRange6)

    ' 並べ替えたデータを新しいシートに出力
    For i = 1 To UBound(combinedData1)
        destSheet.Cells(i + 2, 2).Value = combinedData1(i, 1) ' 文字をB列に出力
        destSheet.Cells(i + 2, 3).Value = combinedData1(i, 2) ' 数字をC列に出力
    Next i

    For i = 1 To UBound(combinedData2)
        destSheet.Cells(i + 2, 4).Value = combinedData2(i, 1) ' 文字をD列に出力
        destSheet.Cells(i + 2, 5).Value = combinedData2(i, 2) ' 数字をE列に出力
    Next i

    For i = 1 To UBound(combinedData3)
        destSheet.Cells(i + 2, 6).Value = combinedData3(i, 1) ' 文字をF列に出力
        destSheet.Cells(i + 2, 7).Value = combinedData3(i, 2) ' 数字をG列に出力
    Next i

    For i = 1 To UBound(combinedData4)
        destSheet.Cells(i + 2, 8).Value = combinedData4(i, 1) ' 文字をH列に出力
        destSheet.Cells(i + 2, 9).Value = combinedData4(i, 2) ' 数字をI列に出力
    Next i

    For i = 1 To UBound(combinedData5)
        destSheet.Cells(i + 2, 10).Value = combinedData5(i, 1) ' 文字をJ列に出力
        destSheet.Cells(i + 2, 11).Value = combinedData5(i, 2) ' 数字をK列に出力
    Next i

    For i = 1 To UBound(combinedData6)
        destSheet.Cells(i + 2, 12).Value = combinedData6(i, 1) ' 文字をL列に出力
        destSheet.Cells(i + 2, 13).Value = combinedData6(i, 2) ' 数字をM列に出力
    Next i

    MsgBox "新しいシートが作成されました。"

End Sub

Function CombineAndSortData(rng As Range) As Variant
    Dim dataArr As Variant
    Dim combinedArr() As Variant
    Dim i As Long, j As Long, n As Long

    dataArr = rng.Value
    ReDim combinedArr(1 To (UBound(dataArr, 1) * (UBound(dataArr, 2) / 2)), 1 To 2)

    n = 1
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2) Step 2
            combinedArr(n, 1) = dataArr(i, j) ' 文字
            combinedArr(n, 2) = dataArr(i, j + 1) ' 数字
            n = n + 1
        Next j
    Next i

    ' 数字に基づいて並び替え
    combinedArr = SortArray(combinedArr, 2, True)

    CombineAndSortData = combinedArr
End Function

Function SortArray(arr As Variant, sortColumn As Long, ascending As Boolean) As Variant
    Dim temp As Variant
    Dim i As Long, j As Long
    Dim comparisonResult As Boolean

    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            comparisonResult = arr(i, sortColumn) < arr(j, sortColumn)
            If ascending = False Then comparisonResult = Not comparisonResult

            If comparisonResult Then
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp

                temp = arr(i, 2)
                arr(i, 2) = arr(j, 2)
                arr(j, 2) = temp
            End If
        Next j
    Next i

    SortArray = arr
End Function

ChatGPTに聞いて、違っていれば、上書きして修正してくれるというのが嬉しいです。
条件をきちんと入れることが大事ですが、ニュアンスが伝わっていない時は、
指示を分けて、順番に進めていくのも良いなと思います。

これで、毎月集計に15分かかっていた作業が1分で出来そう
1年間で180分（3時間）かかっていた作業が12分になる計算です！

時間が短縮出来たので、メール3件ぐらい返信出来ました。
小さい進歩ですが、他にも使えそうです。
皆さんも、何か報告書を作成する時に、
今あるデータから、必要な情報だけにして欲しいことがあると思うので、
そんな時は、ChatGPTに聞いて、解決を図るのがオススメです。

５.さらに可能性が広がる

下記の記事だと、ダウンロードしたExcelデータを
１つのファイルに集約して保存が出来るようです。

このスキルが身につけば、集約作業も早くなるのではないかと思っています。
今回の並べ替えマクロだけでなく、
ChatGPTで自分の思うマクロ作成スキルが身につけば、
必要な情報だけに加工することも短時間で出来そうです。

集約作業・加工編集作業も早くなる…鬼に金棒ですね！

・参考にさせていただいた記事
Excelデータをマクロにされている記事です。

最後に、ChatGPTに感謝を伝えると、
嬉しいコメントが返って来ました！

皆さんもぜひ、ChatGPTと、お友達になって下さい