
以下のような一セル内で改行された文字列を改行ごとに分割して別シートへコピーするExcelVBAを作成したいと考えています。
(以下は山田さんのレコード一行を記載しましたが下のセルに担当者のレコードが同様に続きます。)
A B C D
----------+---------------+------------+---------------+
担当者 日付 履歴 更新日
----------+---------------+------------+---------------+
山田 2001/01/01 札幌支店 2005/01/01
2002/01/01 福岡支店 2005/04/01
2003/04/01 東京支店 2005/04/01
----------+---------------+------------+---------------+
上記を別シートへ以下のようにセル内容を分割してコピーしたいのです。
A B C D
----------+---------------+------------+---------------+
担当者 日付 履歴 更新日
----------+---------------+------------+---------------+
山田 2001/01/01 札幌支店 2005/01/01
----------+---------------+------------+---------------+
山田 2002/01/01 福岡支店 2005/04/01
----------+---------------+------------+---------------+
山田 2003/04/01 東京支店 2005/04/01
----------+---------------+------------+---------------+
※質問の表記で-------------+-----------と記載しているのは
セルをイメージしました。A1に「担当者」A2に「山田」と記載しているイメージです。問題はB.C.D列のセル内容ですが前任者が一つのセルに改行を利用して入力しているため、内容を行に分割したいと考えています。件数が非常に多く手作業を排除した方法でVBAを利用した方法がわかる方にお教えいただきたく投稿させていただきました。
当方Excel2000を利用していますが上記の処理VBAマクロをどうか教えてください。
No.2ベストアンサー
- 回答日時:
Sheet2には最低限項目名が記入されていると仮定しています
下記のような感じでしょう
Sub Macro1()
Dim r1 As Range, r2 As Range, s As String
Dim ar() As String, n As Integer, m As Integer, i As Integer
' Sheet1のA2セルから開始
Set r1 = Sheet1.Range("A2")
' Sheet2のA列の最後+1行目から開始
Set r2 = Sheet2.Range("A65536").End(xlUp).Offset(1)
' Sheet1のデータが無くなるまでループ
Do While r1.Value <> ""
' セル内改行の最大数を記憶するための変数iを初期化
i = 0
For m = 1 To 3
' Sheet1の B,C,D列のデータをLFで分割
ar = Split(r1.Offset(0, m).Value, vbLf)
For n = 0 To UBound(ar)
' Sheet2へ転記
r2.Offset(n, m).Value = ar(n)
Next
' 分割数の最大値を判断
If UBound(ar) + 1 > i Then i = UBound(ar) + 1
Next
s = r0.Value
' Sheet2のA列に転記
r2.Resize(i, 1).Value = s
' Sheet1を次行に移動
Set r1 = r1.Offset(1)
' Sheet2を転記した次の行に移動
Set r2 = r2.Offset(i)
Loop
End Sub
No.4
- 回答日時:
ANo.3です。
ミスしてました。
>ReDim Preserve v(1 To 4, 1 To i - 1)
を
ReDim Preserve v(1 To 4, 1 To i)
に変更願います。
No.3
- 回答日時:
シート1からシート2へ書き出すサンプル。
Sub try()
Dim r As Range
Dim v, vv1, vv2, vv3
Dim i As Long, k As Integer
With Worksheets("Sheet1")
ReDim v(1 To 4, 1 To .Cells.Rows.Count)
For Each r In .Range(.[A2], .Cells(Rows.Count, 1).End(xlUp))
vv1 = Split(r.Offset(, 1).Value, vbLf)
vv2 = Split(r.Offset(, 2).Value, vbLf)
vv3 = Split(r.Offset(, 3).Value, vbLf)
For k = 0 To UBound(vv1)
i = i + 1
v(1, i) = r.Value
v(2, i) = vv1(k)
v(3, i) = vv2(k)
v(4, i) = vv3(k)
Next
Next
ReDim Preserve v(1 To 4, 1 To i - 1)
End With
With Worksheets("Sheet2")
.Range("A1:D1").Value = Array("担当者", "日付", "履歴", "更新日")
.Range("A2").Resize(UBound(v, 2), 4).Value = Application.Transpose(v)
End With
Erase v
End Sub
ご参考になれば。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
今、見られている記事はコレ!
-
弁護士が解説!あなたの声を行政に届ける「パブリックコメント」制度のすべて
社会に対する意見や不満、疑問。それを発信する場所は、SNSやブログ、そしてニュースサイトのコメント欄など多岐にわたる。教えて!gooでも「ヤフコメ民について」というタイトルのトピックがあり、この投稿の通り、...
-
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」
「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
-
釣りと密漁の違いは?知らなかったでは済まされない?事前にできることは?
知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
-
カスハラとクレームの違いは?カスハラの法的責任は?企業がとるべき対応は?
東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。 この動きは自治体...
-
なぜ批判コメントをするの?その心理と向き合い方をカウンセラーにきいた!
今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelVBAを使って、値...
-
i=cells(Rows.Count, 1)とi=cel...
-
任意フォルダから画像をすべて...
-
Excel vbaで特定の文字以外が入...
-
エクセルVBAでできるでしょ...
-
Excel VBA、 別ブックの最終行...
-
特定のセルが空白だったら、そ...
-
【VBA】指定したセルと同じ値で...
-
DataGridViewのセル編集完了後...
-
Excelで指定した日付から過去の...
-
【Excel VBA】指定行以降をクリ...
-
Application.Matchで特定行の検索
-
【Excel VBA】セルの色によって...
-
【Excel】指定したセルの名前で...
-
[Excel VB]プルダウンで文字選...
-
マクロで行がグループ化されて...
-
13箇所の株価をエクセルにRSSで...
-
VBAで検索して指定の位置に行を...
-
Excel VBAで、 ヘッダーへのセ...
-
screenupdatingが機能しなくて...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
特定のセルが空白だったら、そ...
-
特定行の色を変えたい(FlexGrid)
-
i=cells(Rows.Count, 1)とi=cel...
-
Excelで指定した日付から過去の...
-
エクセルvbaで、別シートの最下...
-
VBA実行後に元のセルに戻りたい
-
Application.Matchで特定行の検索
-
”戻り値”が変化したときに、マ...
-
VBAでセルをクリックする回...
-
任意フォルダから画像をすべて...
-
Excel VBAで、 ヘッダーへのセ...
-
TODAY()で設定したセルの日付...
-
【Excel VBA】指定行以降をクリ...
-
Excel vbaで特定の文字以外が入...
-
ExcelのVBAで数字と文字列をマ...
-
Excel VBA、 別ブックの最終行...
-
DataGridViewの各セル幅を自由...
-
VBA ユーザーフォーム ボタンク...
-
連続する複数のセル値がすべて0...
おすすめ情報