文字列で判別した上で、所定の場所にデータを格納したい。

投稿者 : Kindle     投稿日時 : 2024/07/31(Wed) 00:00:41     OS : Windows 10     EXCEL : Excel 2019

---

Excel VBAでのデータ整形について

初めまして。
業務上のでVBAを改修したいのですが、素人なもので以下のコードの誤っている点をご指摘いただければ大変幸いです。

# やりたいこと
トラックの出発地によってデータを整列したいです。
「一覧」シートのD列の最初の3文字によって、一覧シートのB-M列のデータを「貼り付け用」シートの指定された場所にそれぞれ格納したい
順番は東京→名古屋→大阪の順。
データ自体は東京→名古屋→大阪の順番に出力される。
「貼り付け用」シートそれぞれの項目の順番は「一覧」シートの順番そのままでOK
最終的には、「貼り付け用」シートに出力されたデータを別のスプレッドシートに貼り付けるイメージ。

# データの順番
1-51行目：東京のデータ
*東京のヘッダーは別シートにデフォルトで記入されているため不要。
52,53行目：名古屋のヘッダー
54-80行目：名古屋のデータ
81-82行目：大阪のヘッダー
名古屋のヘッダーは大阪ヘッダーと同一。`名古屋発`を`大阪発`にするのみでOK
83行目以降：大阪のデータ
大阪のデータは最大でも5件ほどになるので、83-87行目のように定義してもOK

# 困っていること
おそらくデータは東京とその他みたいな区切りになっている(?)
最初の3文字で東京、名古屋、大阪で判断したい
自分で以下のコードのようにいじってみたものの、以下のような問題点が出てしまいました。
NGO, OSAのヘッダーのデータが消失した
NGOのデータがTYOのデータ直後に格納された
OSAのデータがNGOのデータの直後に格納された

Sub 貼付用編集()
    '
    ' スプレッドシートに貼り付けやすいように編集する
    '
    Dim i As Integer
    Dim lastRow As Long, lastRow2 As Long
    Dim NGO_row As Long
    Dim OSA_row As Long
    Dim cel1 As String
    Dim cel2 As String

    NGO_row = 52        'NGO発の入る行を設定する
    OSA_row = 74        'OSA発の入る行を設定する

    Worksheets("貼付用").Cells.Clear

    Worksheets("一覧").Activate

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

    With Sheets("一覧")
        Sheets("貼付用").Range("a1").Resize(lastRow - 1, 13).Value = _
        .Range(.Cells(2, 2), .Cells(lastRow, 14)).Value                      '一覧シートの2行目以降を貼付用シートに貼り付ける
    End With

    Worksheets("貼付用").Activate

    Range("A:L").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)         '重複を削除する

    lastRow2 = Cells(Rows.Count, "B").End(xlUp).Row

    ' NGO発のヘッダーを追加する
    For i = 1 To lastRow2
        If Left(Cells(i, 3).Text, 3) <> "TYO" Then
            Rows(NGO_row & ":" & NGO_row + 1).Insert Shift:=xlDown
            Cells(NGO_row, 1).Value = "NGO発"
            Cells(NGO_row, 6).Value = "'=G5"
            Cells(NGO_row, 7).Value = "'=H5"
            Cells(NGO_row, 8).Value = "'=I5"
            Cells(NGO_row, 9).Value = "'=J5"
            Cells(NGO_row, 10).Value = "'=K5"
            Cells(NGO_row, 11).Value = "'=L5"
            Cells(NGO_row, 12).Value = "'=M5"
            Cells(NGO_row + 1, 6).Value = "'=G6"
            Cells(NGO_row + 1, 7).Value = "'=H6"
            Cells(NGO_row + 1, 8).Value = "'=I6"
            Cells(NGO_row + 1, 9).Value = "'=J6"
            Cells(NGO_row + 1, 10).Value = "'=K6"
            Cells(NGO_row + 1, 11).Value = "'=L6"
            Cells(NGO_row + 1, 12).Value = "'=M6"
            Exit For
        End If
    Next i

    ' OSA発のヘッダーを追加する
    For i = 1 To lastRow2
        If Left(Cells(i, 3).Text, 3) <> "NGO" Then
            Rows(OSA_row & ":" & OSA_row + 1).Insert Shift:=xlDown
            Cells(OSA_row, 1).Value = "OSA発"
            Cells(OSA_row, 6).Value = "'=G5"
            Cells(OSA_row, 7).Value = "'=H5"
            Cells(OSA_row, 8).Value = "'=I5"
            Cells(OSA_row, 9).Value = "'=J5"
            Cells(OSA_row, 10).Value = "'=K5"
            Cells(OSA_row, 11).Value = "'=L5"
            Cells(OSA_row, 12).Value = "'=M5"
            Cells(OSA_row + 1, 6).Value = "'=G6"
            Cells(OSA_row + 1, 7).Value = "'=H6"
            Cells(OSA_row + 1, 8).Value = "'=I6"
            Cells(OSA_row + 1, 9).Value = "'=J6"
            Cells(OSA_row + 1, 10).Value = "'=K6"
            Cells(OSA_row + 1, 11).Value = "'=L6"
            Cells(OSA_row + 1, 12).Value = "'=M6"
            Exit For
        End If
    Next i

    lastRow2 = Cells(Rows.Count, "B").End(xlUp).Row

    ' 区間を到着地だけの3レターにする
    For i = 1 To lastRow2
        Cells(i, 3).Value = Right(Cells(i, 3).Value, 3)
    Next i

    Range(Cells(1, 1), Cells(lastRow2, 12)).Select
End Sub

投稿者 : さんこう     投稿日時 : 2024/07/31(Wed) 09:06:24

---

＞以下のような問題点が出てしまいました。

コードから推測すると、「問題点」の認識が違っています。

＞NGO, OSAのヘッダーのデータが消失した

「消失した」のではなく、別のところにあると思われます。

＞NGOのデータがTYOのデータ直後に格納された
＞OSAのデータがNGOのデータの直後に格納された

「格納された」のではなく、元のままになっているのでしょう。


これ↓の動作を確認してみるといいでしょう。

Rows(NGO_row & ":" & NGO_row + 1).Insert