[[20140730130520]] 『文字列をすべて組み合わせたい』(tamayan) ページの最後に飛ぶ

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

 

『文字列をすべて組み合わせたい』(tamayan)

こんにちは。マクロの件で質問をお願いします。

A,B,C列の4行目以降にそれぞれ文字列が入っています。
A,B列はかならず組み合わせる文字列で、C列の文字列は、すべて組み合わせて
60文字以下になる文字列の組み合わせを抽出してD列に表示したいのです。

A列   B列   C列
ああ  1111   ABCDE
いい  2222   FGH 
           IJKLMNO
           PQRS
           TUVWX
           WZ
  
A列+B列+C列 <=60 ⇒D列に記載といった感じです。

ネットに載っていたコードを編集して作成したコードが以下になります。
このコードだとC列の上から順に文字列を足していって60文字以上になったら
ループを抜けてD列に記載する感じなので、すべて組み合わせるようにはなっていません。
C列をすべて組み合わせるコードを作成したいので、添削をよろしくお願いいたします。

Sub 並べ替え実行()
Dim mc, ac, bc, cc
Dim Target As String

最大行数を確定
ac = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
bc = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
cc = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row

mc = IIf(ac > bc, ac, bc)
mc = IIf(cc > mc, cc, mc)
一挙に二次元配列で取得
Dim rc
rc = ActiveSheet.Range("A1:C" & mc).Value
順列作成
Dim nr, ar, br, cr, dr
nr = 4

For ar = 4 To ac
For br = 4 To bc

    If Right(rc(ar, 1), 1) = "■" Then
        Target = rc(ar, 1) & rc(br, 2)
    Else
        Target = rc(ar, 1) & " " & rc(br, 2)
    End If

    For cr = 4 To cc
       If LenB(StrConv(Target & " " & rc(cr, 3), vbFromUnicode)) <= 60 Then
           Target = Target & " " & rc(cr, 3)
       Else
       End If
Next cr
ActiveSheet.Range("D" & nr).Value = Target
nr = nr + 1
Next br
Next ar
Debug.Print nr - 1
End Sub

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


    For cr = 4 To cc
       If LenB(StrConv(Target & " " & rc(cr, 3), vbFromUnicode)) <= 60 Then
           Target = Target & " " & rc(cr, 3)
       Else
       End If
Next cr
ActiveSheet.Range("D" & nr).Value = Target
nr = nr + 1
Next br
 この部分を

            For cr = 4 To cc
               If LenB(StrConv(Target & " " & rc(cr, 3), vbFromUnicode)) <= 60 Then
                    ActiveSheet.Range("D" & nr).Value = Target & " " & rc(cr, 3)
                    nr = nr + 1
                End If
            Next cr
            Target = ""
        Next br

 でどうでしょう?
  
(HANA) 2014/07/30(水) 16:16

HANAさん

コメントありがとうございますm(__)m
文字列が60文字以下というところなんですが、C列をA,B列と合わせて60文字ギリギリまで
組み合わせてその文字列をD列に書き出したいのです。
説明がわかりにくくて申し訳ありません。
(tamayan) 2014/07/30(水) 16:51


 ちょっとよくわからないので
 サンプルをつかって、具体的な希望結果図を載せてもらえますか?
  
(HANA) 2014/07/30(水) 17:00

 もしかして、こういう事かな?

        For cr = 4 To cc
            Target = Target & " " & rc(cr, 3)
        Next cr

        If LenB(StrConv(Target, vbFromUnicode)) <= 60 Then
            ActiveSheet.Range("D" & nr).Value = Target
            nr = nr + 1
        End If     
        Target = ""
    Next br
  
(HANA) 2014/07/31(木) 15:09

HANAさん、コメントありがとうございます。
サンプルを使って説明致します。

A列   B列   C列
ああ  1111   ABCDE
いい  2222   FGH 
           IJKLMNO
           PQRS
           TUVWX
           WZ

A列とB列の組み合わせは
ああ 1111
ああ 2222
いい 1111
いい 2222

の4つになります。

この後にC列の文字列を60文字以下ギリギリになるまで追加していきたいのですが、
ああ 1111 ABCDE         ※60文字以下⇒次の文字列を追加

ああ 1111 ABCDE FGH       ※60文字以下⇒次の文字列を追加

ああ 1111 ABCDE FGH IJKLMNO   ※60文字より大きい⇒文字列を追加せず次の文字列を追加

ああ 1111 ABCDE FGH PQRS    ※60文字以下⇒次の文字列を追加

ああ 1111 ABCDE FGH PQRS TUVWX ※60文字より大きい⇒次の文字列を追加

ああ 1111 ABCDE FGH PQRS WZ   ※60文字以下⇒次の文字列がないのでここで終了

D列に"ああ 1111 ABCDE FGH PQRS WZ"を記入。

次にC列2番目の文字列"FGH"を先頭に持ってきて同じような感じで処理を行う。
ああ 1111 FGH
ああ 1111 FGH PQRS
ああ 1111 FGH PQRS TUVWX
ああ 1111 FGH PQRS TUVWX WZ
ああ 1111 FGH PQRS TUVWX WZ ABCDE

イメージとしてはこんな感じです。
これをすべての組み合わせでやっていきたいのですが、出来ますでしょうか?
説明下手ですみません、よろしくお願いいたします。

(tamayan) 2014/07/31(木) 16:30


 変数を二つ追加して
 Dim i As Long, MyStr As String

 こんな感じで?
            For i = 0 To cc - 5
                For cr = 4 + i To cc
                    If LenB(StrConv(Target & MyStr & " " & rc(cr, 3), vbFromUnicode)) <= 60 Then
                        MyStr = MyStr & " " & rc(cr, 3)
                    End If
                Next cr
                ActiveSheet.Range("D" & nr).Value = Target & MyStr
                MyStr = ""
                nr = nr + 1
            Next i
        Next br
  
(HANA) 2014/08/01(金) 16:21

 あ、すみません。
 Next cr
 の後に、飛ばしたところのループ
 For cr = 4 To 3 + i
   〜
   〜
 Next cr
 がいりますね。

 どうですか?
 
 (HANA)

HANAさん

ありがとうございます!
希望通りに動いてくれました。感謝です。

本当にありがとうございました!m(__)m
(tamayan) 2014/08/04(月) 09:27


コメント返信:

[ 一覧(最新更新順) ]


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