以下のような一セル内で改行された文字列を改行ごとに分割して別シートへコピーする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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) エクセルについて教えてください。 3 2023/06/28 09:11
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- Excel(エクセル) エクセル表作成について 5 2023/03/12 13:25
- Visual Basic(VBA) 複数指定セルの可視セルのみを別シートに転記するVBAについて 2 2022/05/27 21:19
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) エクセル VBA セルの結合 2 2022/09/07 11:48
- Visual Basic(VBA) 顧客ごとに違う点検案内を作成するマクロ 4 2022/09/16 05:34
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/01/26 09:50
- Excel(エクセル) EXCEL 関数を教えてください。(A列の同じ値が複数ある場合vlookupで出来ますか) 4 2022/12/07 20:54
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで指定した日付から過去の...
-
ExcelVBAを使って、値...
-
DataGridViewの各セル幅を自由...
-
VBAでセル同士を比較して色付け
-
Excel VBA、 別ブックの最終行...
-
特定のセルが空白だったら、そ...
-
エクセルvbaで、別シートの最下...
-
VBAでセルをクリックする回...
-
【Excel VBA】指定行以降をクリ...
-
【VBA】シート上の複数のチェッ...
-
Excel vbaについて知恵もしくは...
-
DataGridViewで列、行、セルの選択
-
Excel VBAで、 ヘッダーへのセ...
-
【VBA】指定したセルと同じ値で...
-
VBA ユーザーフォーム ボタンク...
-
スプレッドシートの数値列に対...
-
i=cells(Rows.Count, 1)とi=cel...
-
結合セルを含む列の非表示方法
-
Excel VBA 計算式を代入するには?
-
ExcelのVBAで数字と文字列をマ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
i=cells(Rows.Count, 1)とi=cel...
-
Excelで指定した日付から過去の...
-
エクセルvbaで、別シートの最下...
-
特定のセルが空白だったら、そ...
-
VBA実行後に元のセルに戻りたい
-
【Excel VBA】指定行以降をクリ...
-
任意フォルダから画像をすべて...
-
【Excel】指定したセルの名前で...
-
VBAでセルをクリックする回...
-
【VBA】シート上の複数のチェッ...
-
EXCELのVBA-フィルタ抽出後の...
-
Excelのプルダウンで2列分の情...
-
Excel vbaで特定の文字以外が入...
-
TODAY()で設定したセルの日付...
-
”戻り値”が変化したときに、マ...
-
ExcelのVBAで数字と文字列をマ...
-
VBA ユーザーフォーム ボタンク...
-
Excel VBA マクロ ある列の最終...
-
Excel VBA、 別ブックの最終行...
おすすめ情報
