人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

住所禄を作成しています。一般的な以下のように1行に一社にしたいのですが、

A社 郵便番号 住所 TEL

現在、手元にあるデータが、

A社
住所 103-0000東京都中央区○○1丁目
TEL 03-1234-5678

と3行にわたり、5つのセルのデータです。
このデータを1行で、以下のようにする為の、
マクロを教えて下さい。

A社 103-0000 東京都中央区○○1丁目 03-1111-1111


●質問者: surippa20
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● きゃづみぃ
●100ポイント
Sub test()
 Dim 開始行 As Long
 Dim a As Long
 
 開始行 = 1
 
 For a = 1 To Rows.Count
 If Cells(a, "A") = "" Then Exit For
 Cells(a, "B") = Cells(a + 1, "B")
 Cells(a, "C") = Cells(a + 2, "B")
 Rows(a + 2).Delete
 Rows(a + 1).Delete
 
 Next a

End Sub

surippa20さんのコメント
早々にありがとうございます。 そのままマクロに入れたのですが、うまく表示しませんでした。中身を見てみようと思います。

2 ● oil999
●300ポイント ベストアンサー

郵便番号と住所が1つのセルに入っていて、これを分離するという前提です。
変換元のシートは変数 sour に、変換先のシートは変数 dest に指定してください。

コメント

各会社の間に、空白行があり、そこで止まってしまいました。空白行は、1行のものもあれば2行のものもあります。
自分自身で省けるか少しやってみます。もし解決策がありましたらお願いいたします。

を受けて、マクロを変更しました。
お試しください。

Sub main()
 Dim v As Variant
 Dim sour, dest As String
 Dim i, j, ln As Long
 sour = "Sheet1"
 dest = "Sheet2"

 ln = Worksheets(sour).Cells(Rows.Count, "A").End(xlUp).Row
 i = 1
 j = 1
 While (i <= ln)
 Do
 v = Worksheets(sour).Cells(i, 1).Value
 i = i + 1
 Loop While (v = "" And i <= ln)
 Worksheets(dest).Cells(j, 1).Value = v
 v = Worksheets(sour).Cells(i, 2).Value
 Worksheets(dest).Cells(j, 2).Value = Left(v, 8)
 Worksheets(dest).Cells(j, 3).Value = Mid(v, 9)
 i = i + 1
 v = Worksheets(sour).Cells(i, 2).Value
 Worksheets(dest).Cells(j, 4).Value = v
 i = i + 1
 j = j + 1
 Wend
End Sub


surippa20さんのコメント
早々にありがとうございます。 はじめうまくいきませんでしたが、シート名を変更していた為でした。「Sheet1」にしたことで表示されました。 ですが、お伝え漏れがありました。各会社の間に、空白行があり、そこで止まってしまいました。空白行は、1行のものもあれば2行のものもあります。 自分自身で省けるか少しやってみます。もし解決策がありましたらお願いいたします。

oil999さんのコメント
コメントを受けて、回答のマクロを修正しました。 お試しください。

surippa20さんのコメント
早々に大変助かります。 できました。ありがとうございました。

3 ● きゃづみぃ
●100ポイント

会社間に空行の対応をしました。


Sub test()
 Dim 開始行 As Long
 Dim a As Long
 Dim b As Long
 
 開始行 = 1
 b = 開始行
 
 For a = 開始行 To Cells(Rows.Count, "A").End(xlUp).Row
 If Cells(b, "A") = "" Then
 Rows(b).Delete
 Else
 Cells(b, "B") = Cells(b + 1, "B")
 Cells(b, "C") = Cells(b + 2, "B")
 Rows(b + 2).Delete
 Rows(b + 1).Delete
 b = b + 1
 End If
 Next a

End Sub

きゃづみぃさんのコメント
記述するのは 該当シートのところに してください。

surippa20さんのコメント
早々に大変助かります。 表示結果は以下のようになりました。 「A社」「111-1111 東京都中央区○○1丁目」「03-1111-1111」の3セルになりました。

きゃづみぃさんのコメント
郵便番号と住所の間に 空白が あったんですね。 見落としてました。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ