[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『A列の複数行を』(多摩)
シート1のA列の複数行を"\"で区切って別シート2に書き出すことを考えています。
以下は全ての行で¥が4つ有る想定ですが
実際は、行によって¥の個数が違うので実際は使えません。
実際の行の¥の個数を調べて1行ずつ処理する事になると思いますが
どのように改造すれば良いでしょうか ?
Sub 区切り文字で分割()
Dim i As Long, tmp As Variant Dim lcn As Long Dim Sh2 As Worksheet, Sh3 As Worksheet
Set Sh2 = Worksheets("DATA") Set Sh3 = Worksheets("区切り文字分離")
lcn = Sh2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lcn tmp = Split(Sh2.Cells(i, 1), "\") Sh3.Cells(i, 2) = tmp(0) Sh3.Cells(i, 3) = tmp(1) Sh3.Cells(i, 4) = tmp(2) Sh3.Cells(i, 5) = tmp(3) Next i End Sub
< 使用 Excel:Office365、使用 OS:Windows10 >
vv = Split(Cells(1, 1).Value, "\")
Range("B1").Resize(, UBound(vv) + 1).Value = vv
(楽) 2022/11/25(金) 17:03:29
Sub test() Dim sh2 As Worksheet, sh3 As Worksheet Dim i As Long, j As Long, tmp Set sh2 = Worksheets("DATA") Set sh3 = Worksheets("区切り文字分離") For i = 1 To sh2.Cells(Rows.Count, "A").End(xlUp).Row tmp = Split(sh2.Cells(i, 1), "\") For j = 0 To UBound(tmp) sh3.Cells(i, j + 2) = tmp(j) Next Next End Sub (フォーキー) 2022/11/25(金) 17:07:23
(楽) 2022/11/25(金) 17:11:12
Dim sh2 As Worksheet, sh3 As Worksheet Dim i As Long, j As Long, tmp Set sh2 = Worksheets("DATA") Set sh3 = Worksheets("区切り文字分離") For i = 1 To sh2.Cells(Rows.Count, "A").End(xlUp).Row tmp = Split(sh2.Cells(i, 1), "\") Cells(i, 2).Resize(, UBound(tmp) + 1).Value = tmp Next End Sub
Resizeで配列をまとめて貼り付けられるんですね。
知らなかったです。
楽さん勉強になりました。
(フォーキー) 2022/11/25(金) 17:13:41
>Office365 これで間違いないのなら TEXTSPLIT 関数でできますけどね。
パワークエリでもできます(365でなくても)
以上、参考まで (笑) 2022/11/25(金) 17:22:01
皆様からいくつか解決のヒントを頂きましたが、
難しいことはスキルが無いので今回はフォーキーさんのVBAコードをそのまま参考にさせていただきました。
土曜日は忙しくやっと時間が取れましたのでサンプルで試してみました。
B列から区切られた文字列が抽出出来ていてA列が空白なので
A列に必要/必要なし用のチェック文字を書き込むようにしました。
(具体的には、必要ないなら「x」を記入)
目で見て行を一つずつ列を参考に見ていくので面倒では有りますが
これで間違いなく判断ができそうです。
で次にSub 不要行削除()で不要行を削除して
Sub 区切り文字で再結合()で最終的に必要な行を求めようとしました。
Sub 区切り文字で再結合()は、列で区切られた文字列を
「\」で結合するのですが、ここで思考が停止しています。
とりあえず動かない「Sub 区切り文字で再結合()」を下記に掲載します。
どうすれば良いかアドバイスをお願いします。
(質問内容が違っているので新規質問を立ち上げるべきでしょうがお許しください。)
Sub 区切り文字で分割_1()
Dim sh2 As Worksheet, sh3 As Worksheet Dim i As Long, j As Long, tmp Dim lcn As Long
Set sh2 = Worksheets("検索") Set sh3 = Worksheets("区切り文字分離")
sh3.Cells.Clear
lcn = sh2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lcn tmp = Split(sh2.Cells(i, "A"), "\") For j = 0 To UBound(tmp) sh3.Cells(i, j + 2) = tmp(j) Next Next
sh3.Columns("A:I").AutoFit
End Sub
Sub 不要行削除()
Dim i As Long Dim sh3 As Worksheet Dim lcn As Long
Set sh3 = Worksheets("区切り文字分離")
lcn = sh3.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = lcn To 1 Step -1 If sh3.Cells(i, "A") = "x" Then sh3.Rows(i).Delete End If Next
Application.ScreenUpdating = True
End Sub
Sub 区切り文字で再結合()
Dim i As Long Dim j As Single, k As Single Dim sh3 As Worksheet Dim lcn As Long
Set sh3 = Worksheets("区切り文字分離")
lcn = sh3.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lcn j = sh3.Rows(i).Column.Count For k = 1 To j - 1 '各列を¥でj-1回結合する cells(i,"A")=cells( −−−−−−−−−−−> これ以降がわかりません。 Next Next
End Sub
(多摩) 2022/11/27(日) 16:15:05
Sub 区切り文字で分割_1_整理() Dim sh3 As Worksheet Dim i As Long Dim 配列 As Variant
Stop 'ブレークポイントの代わり Set sh3 = Worksheets("区切り文字分離") sh3.Cells.Clear
With Worksheets("検索") For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row 配列 = Split(.Cells(i, "A").Value, "\") sh3.Cells(i, "B").Resize(, 1 + UBound(配列)).Value = 配列 Next i End With
sh3.Columns("A:I").AutoFit End Sub
そして【不要行削除】を整理するとこうなります。
Sub 不要行削除_整理() Dim i As Long
With Worksheets("区切り文字分離") For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 If .Cells(i, "A") = "x" Then .Rows(i).Delete Next End With End Sub
ここから察するに、
区切り文字分離シートの1〜B列最終行までを順番に
各行のB列〜最終列までの内容を"\"を挟みながらくっつけてA列に出力したいということでしょうか?
それならば、Join関数(とワークシート関数のTranspose)を使うとよいと思います。
Sub 研究用() Dim 最終列 As Long Dim 行 As Long
Stop 'ブレークポイントの代わり
With Worksheets("区切り文字分離") For 行 = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row 最終列 = .Cells(行, .Columns.Count).End(xlToLeft).Column If 最終列 <= 2 Then .Cells(行, "A").Value = .Cells(行, "B").Value Else .Cells(行, "A").Value = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(行, "B").Resize(, 最終列 - 1).Value)), "\") End If Next 行 End With End Sub
(もこな2) 2022/11/27(日) 16:51:40
Sub 分離() Dim sh2 As Worksheet, sh3 As Worksheet Dim lcn As Long, i As Long, tmp Set sh2 = Worksheets("検索") Set sh3 = Worksheets("区切り文字分離") lcn = sh2.Cells(Rows.Count, "A").End(xlUp).Row '元データを分離シートB列に転記 sh3.Range("B1").Resize(lcn).Value = sh2.Range("A1").Resize(lcn).Value For i = 1 To lcn tmp = Split(sh3.Cells(i, 2), "\") 'C列以降に区切り文字を転記 sh3.Cells(i, 3).Resize(, UBound(tmp) + 1).Value = tmp Next End Sub
Sub 削除() Dim sh3 As Worksheet Dim lcn As Long, i As Long Set sh3 = Worksheets("区切り文字分離") sh3.Rows(1).Insert lcn = sh3.Cells(Rows.Count, "B").End(xlUp).Row With sh3.Range("A1") .Value = "不要行" 'Xを抽出し、可視行を削除 .AutoFilter 1, "X" If WorksheetFunction.Subtotal(3, sh3.Range("B2").Resize(lcn - 1)) > 0 Then With .CurrentRegion.Offset(1, 0) .Resize(.Rows.Count - 1).EntireRow.Delete End With 'A列及びC列以降削除(終わりの列は変更してください) sh3.Range("A1,C1:L1").EntireColumn.Delete End If End With sh3.AutoFilterMode = False sh3.Rows(1).Delete End Sub (フォーキー) 2022/11/27(日) 22:58:16
既に提案されてましたが、データ区切り位置(TextToColumns)を使って分離 結合は、TEXTJOIN関数を使ってみました。
Sub 分離() Worksheets("DATA").Cells(1, 1).CurrentRegion.Copy Worksheets("区切り文字分離").Cells(1, 2) Worksheets("区切り文字分離").Cells(1, 2).CurrentRegion.TextToColumns _ DataType:=xlDelimited, Other:=True, OtherChar:="\" End Sub Public Sub 削除() Dim r As Range, delr As Range For Each r In Worksheets("区切り文字分離").Cells(1, 2).CurrentRegion.Rows If r.Cells(1) = "x" Then If delr Is Nothing Then Set delr = r Else Set delr = Union(delr, r) End If End If Next If Not delr Is Nothing Then delr.Delete Shift:=xlUp End Sub Public Sub 結合() Dim cr1 As Range Set cr1 = Worksheets("区切り文字分離").Cells(1, 2).CurrentRegion Dim cr2 As Range Set cr2 = cr1.Offset(, -1).Resize(, 1) cr2.Formula = "=TEXTJOIN(""\"",TRUE," & cr1.Rows(1).Address(0, 0) & ")" cr2.Value = cr2.Value End Sub (hatena) 2022/11/28(月) 00:56:57
>各行のB列〜最終列までの内容を"\"を挟みながらくっつけてA列に出力したいということでしょうか?
Yesです。
各行のB列〜最終列までの内容を"\"を挟みながらくっつけて行きたいので
Join関数とTranspose関数を使ったもなこ2さんの研究用()コードで思った事ができました。
何回かサンプルコードで検証したいと思いますが
今回のコードで全ての作業が完結した思います。
(多摩) 2022/11/28(月) 08:36:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.