[[20221125164747]]　『A列の複数行を』（多摩）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『A列の複数行を』（多摩）

シート１のA列の複数行を"\"で区切って別シート２に書き出すことを考えています。

以下は全ての行で￥が４つ有る想定ですが
　実際は、行によって￥の個数が違うので実際は使えません。

実際の行の￥の個数を調べて１行ずつ処理する事になると思いますが
どのように改造すれば良いでしょうか　？

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 ＞

こんばんわ＾＾
tmpの最大要素数はUbound(tmp)
で取得できますので、別途ループカウンターを定義して
書き出し部をセル位置と要素の添え字をシンクロさせて
ループ回せば良いのではないでせうか。。。
と。。。思います。＾＾；
m(__)m
（隠居Z） 2022/11/25(金) 17:00:47
例えば

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

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), "\")
        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

お悩みポイントが良くわかりませんが【区切り文字で分割_1】を整理するとこんな感じですよね 
    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

（もこな２） 2022/11/27(日) 16:51:40

区切る前の文字と、結合後の文字は同じという前提
分離シートのB列に検索シートのA列を転記して、C列以降に区切り文字を入れる。
不要行削除は、フィルタでXを抽出して可視行を削除
不要行削除後はA列の削除行フラグ列と、C列以降の区切り文字列を削除するだけ。
※練習がてら書いてますけど、手作業で十分対応可能な内容だと思います。 

 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
もなこ2さん、フォーキーさん、hatenaさん　未熟なコードの整理
及び結合()コードを教えていただきありがとうございます。

＞各行の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.