[[20151008140852]] 『文字列の結合について(VBA)』(ぴあの) ページの最後に飛ぶ

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

 

『文字列の結合について(VBA)』(ぴあの)

質問させて頂きます。

入力されているセル分だけの文字列の結合は可能でしょうか?

皆さん失礼します。

現在ある検索を行い、その結果をシート1の「A1」〜「E1」までに反映させています。
(検索結果の1項目に対して1つのセルに反映させて、最初にヒットした項目から「A1」に反映しています)
検索にヒットした項目の文字列を結合してシート2の「A1」に入力しています。

例えば「むらさき色」という項目がヒットした際にその配合を書き出しています。

<シート1>

    A          B        C    D       E
1「あお(35%)」 |「あか(40%)」 |「あお」 |「あか」 | 「むらさき」 


2          |          |       |     | 

こちらを結合して
むらさき->あか->あお->あか(50%)->あお(50%)と表示させています。

この「むらさき」の項目でしたら5つのセルが必要なので下記のコードでも問題ないのですが
結果項目によっては
「くろ(100%)」だけのように1つのセルだけにしか入力されない事もあります。
セルが空白でも「E1」から指定してしまっているので

<シート1>
    A         B      C    D     E
1「くろ(100%)」 |        |     |     | 


2          |        |     |     |

この時にはB1〜E1までは不要・・・。
この場合は結合させるものがないので、この「くろ(100%)」だけをシート2「A1」に表示させたい。

こちらを入力されているセル分だけを結合し表示させる事は出来ないでしょうか?

現在検索対象ファイルより検索のループを行い、ヒットした文字列をThisWorkbook.Worksheets("sheet1").Cells(1, 1).Valueから順に「E1」までに入力。
1つの項目のループを抜けた時点で文字列の結合。
結合が完了したらシート2、A1に反映。
検索時にヒットしたした文字列をクリアして次の検索ループに入るようにしています。

一応結合して表示は出来ているものの、見にくいので改良したいなと思って調べましたがよく分からずお尋ねしています。

下記現在のコードです。

ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value = ThisWorkbook.Worksheets("sheet1").Cells(1, 5) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 4) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 3) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 2) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 1).Value
ThisWorkbook.Worksheets("sheet1").Range("A1:E1").Clear

*ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value
*項目増えるごとに入力先は k=k+1にて1行増やして入力しています。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value = ThisWorkbook.Worksheets("sheet1").Cells(1, 5) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 4) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 3) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 2) & "->" & _
                            ThisWorkbook.Worksheets("sheet1").Cells(1, 1).Value
を以下に置換

Dim i As Integer, j As Integer
For i = 5 To 1 Step -1
If ThisWorkbook.Worksheets("sheet1").Cells(1, i) <> "" Then
ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value = ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value & _
ThisWorkbook.Worksheets("sheet1").Cells(1, i).Value

    For j = i - 1 To 1 Step -1
    If ThisWorkbook.Worksheets("sheet1").Cells(1, j) <> "" Then ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value = _
    ThisWorkbook.Worksheets("sheet2").Cells(k, 1).Value & "->": Exit For
    Next j
End If
Next i
(mm) 2015/10/08(木) 16:18

 こういうこと?

 Sub test()
    Dim i As Long
    With Sheets("sheet1").Range("a1").CurrentRegion.Resize(, 5)
        For i = 1 To .Rows.Count
            Sheets("sheet2").Cells(i, 1).Value = _
            GetReverse(.Rows(i), "->")
        Next
    End With
End Sub

 Function GetReverse(rng As Range, myJoin As String) As String
    Dim x
    x = StrReverse(Join(Filter(rng.Parent.Evaluate("if(" & rng.Address & _
        "<>"""",column(" & rng.Address & "),char(2))"), Chr(2), 0), ","))
    GetReverse = Join(Application.Index(rng.Value, 0, Split(x, ",")), myJoin)
End Function
(seiya) 2015/10/08(木) 16:21

(mm)さん
有難うございます。私にとってとても分かり易いコードでしたがうまく動かす事が出来ませんでした・・・。
もう少し頂いたコードを自分が使えるように見てみます!

(seiya)さん
有難うございます。
こちらで思い通りの事が出来ました!
ですが Function 以降を理解するのに時間がかかりそうです(苦笑)

お二方ともお時間頂きありがとうございました!!

(ぴあの) 2015/10/08(木) 16:46


 念のため Function GetReverseを以下に変更してください。
  Function GetReverse(rng As Range, myJoin As String) As String
    Dim x
    x = StrReverse(Join(Filter(rng.Parent.Evaluate("if(" & rng.Address & _
        "<>"""",column(" & rng.Address & ")-" & rng(1).Column & "+1,char(2))"), Chr(2), 0), ","))
    GetReverse = Join(Application.Index(rng.Value, 0, Split(x, ",")), myJoin)
End Function

 1) Evaluate Method を使用して、文字列の入力されている列の相対列番号と、空白列にChar(2)が入った一次配列を取得
    (Char(2)は殆ど使用されない文字列、ということで使用)
 2) 1) で取得した配列からFilter関数でChr(2)の要素を排除
 3) 2) の配列の要素ををJoin関数で","で連結しStrReverse関数で逆向きにする。

 ここまでが x=StrReverse(....

 4) Index関数で必要な列だけ抽出してJoin関数でmyJoinで指定された文字列で連結
(seiya) 2015/10/08(木) 17:24

 連結列数が9を超える場合は

  Function GetReverse(rng As Range, myJoin As String) As String
    Dim x, i As Long, temp
    x = Split(Join(Filter(rng.Parent.Evaluate("if(" & rng.Address & _
        "<>"""",column(" & rng.Address & ")-" & rng(1).Column & "+1,char(2))"), Chr(2), 0), ","), ",")
    If UBound(x) > 0 Then
        For i = 0 To UBound(x) \ 2
            temp = x(i): x(i) = x(UBound(x) - i)
            x(UBound(x) - i) = temp
        Next
    End If
    GetReverse = Join(Application.Index(rng.Value, 0, x), myJoin)
End Function
(seiya) 2015/10/08(木) 17:37

(seiya)さん

ご丁寧に2つもご教示頂きましてありがとうございます!!
自分がやりたい事が簡単に出来ました!!

Function〜の説明も有難うございます。
1つずつ理解していきます。

本当にありがとうございました!

(ぴあの) 2015/10/08(木) 18:29


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.