エクセル 表の縦横全てを網羅した入れ替え

こんばんは、エクセル2010を使っています。

画像の様なファイルが有ります。
A~Dまでに文字が入っていて、その全てのパターンを抜き出したいのですが、解りません。

抜き出したいのは、F1行にあるように全ての文字の組み合わせを行い、行方向に表示するものです。

※　実際は３×４行では無く、9×９行などになるのでそれに対応出来るやり方が理想です。
　　詳しい方、教えて頂けませんでしょうか。
　　よろしくお願いします。

質問者からの補足コメント

• 

  画像に間違いがありました　正確には　３の４乗で　81通りになるはずです。
  
  ご指摘いただいたmikeさんありがとうございます。

    補足日時：2015/10/06 13:12

• 

  失礼しました、単純に列に文字を入れれば対応してくれていました。
  
  1点教えて頂けませんでしょうか、例えば1列目が３行で、2列目が2行の場合、2列目の空白も含んで処理をしますが、これを空白は無視する、なんて事できるのでしょうか？
  
  お手数ですが、教えて頂ければ幸いです。
  よろしくお願いいたします。

  No.4の回答に寄せられた補足コメントです。 補足日時：2015/10/07 22:26

No.10 ベストアンサー 回答者： 30246kiku 回答日時： 2015/10/10 06:27

＃７です

>　　Const CCOLR As String = "D" ' A ～ この列まで
これを指定させるのはどうだろうか・・・と思っていたのですが
> 空白は無視するので、とびとびでも
この、とびとび・・・
CurrentRegion　で、最終列を取得できるのか？？
で、最終列を記述してもらうものにしてましたが、
空白あるのは各列の行後半・・・
という使い方なら CurrentRegion で取得できるので
使い勝手は向上するのかなということで

Samp2 からの変更点は ★ 部分だけです


Public Sub Samp3()
　　Dim rng As Range, r As Range
　　Dim i As Long, j As Long, k As Long

　　Application.ScreenUpdating = False
　　k = Range("A1").CurrentRegion.Columns.Count ' ★
　　With Columns(k) ' ★
　　　　.Offset(, 1).Resize(, k + 2).ClearContents
　　　　.SpecialCells(xlCellTypeConstants) _
　　　　　　.Copy .Offset(, k + 1).Cells(1)
　　　　Set rng = .Offset(, k + 1).CurrentRegion
　　End With
　　For i = k - 1 To 1 Step -1
　　　　j = 0
　　　　For Each r In Columns(i).SpecialCells(xlCellTypeConstants)
　　　　　　With rng.Offset(j * rng.Rows.Count)
　　　　　　　　If (j > 0) Then rng.Copy .Cells(1)
　　　　　　　　.Columns(1).Offset(, -1) = r
　　　　　　End With
　　　　　　j = j + 1
　　　　Next
　　　　Set rng = rng.CurrentRegion
　　Next
　　Application.ScreenUpdating = True
End Sub


＃４のお礼に
> やっている事は解らないのですが
とあったので、チョット解説を・・・数学的な話にはならない？かな？

図にあるように、3 x 3 で説明してみます

For の前までに何をやっているか
まず、結果を表示する列幅＋左右１列の範囲をきれいにしておいて
処理対象の最終列の内容をコピーして、塊として覚えます（赤枠）
（図上段）

For に入って
最終列の前の列から順に、１データずつ
「A」の時は、覚えていた塊の１列目左の範囲に「A」を
「B」の時は、塊単位で行をずらしてコピーして（図中段）
その塊の１列目左の範囲に「B」を
「C」も同様の処理を繰り返し、その列を処理しきると（図下段）
その状態を、塊として覚えなおして
さらに前の列「1」の時には、その塊の１列目左の範囲に「1」を
「2」の時は、塊単位で行をずらしてコピーして、
その塊の１列目左の範囲に「2」を・・・と繰り返していきます
列数が多いと、塊として覚えなおす回数が増えますが、
それは Excel さんがやってくれることなので・・・

この回答へのお礼

再度の回答、そして解りやすいご説明を頂き、ありがとうございます。

なるほどなぁ、と思える説明で、後は私がコードを書けるようになれば良い訳ですね。
最後までお付き合い頂き大変感謝しております。

ありがとうございます！

お礼日時：2015/10/10 17:24

No.9 回答者： CoalTar 回答日時： 2015/10/08 17:36

作業列使えば理解しやすいかもってことで最終回答

1. 1行目の上に2行挿入
2. D2セルに =COUNTA(D3:D50)
　 左へオートフィル セル範囲は適宜
3. D1セルに =PRODUCT(D2:$D$2)
　 左へオートフィル
4. F1セルに
　=INDEX(A:A,MOD((ROW(A1)-1)/A$1*A$2,A$2)+3)
　右へ、下へオートフィル 添付図では60行目まで

この回答へのお礼

噛み砕いて教えて頂きありがとうございます。
お陰様で、ばっちり出来たようです、再度の回答を頂き感謝いたします。

ちょっと考えてみます、ありがとうございました。

お礼日時：2015/10/09 23:26

No.8 回答者： CoalTar 回答日時： 2015/10/08 15:58

＞数式のやっている事が理解できなくて、よろしければ列と行がランダムに増加した時の対応方法を教えて頂けませんでしょうか

ランダムって言われても余計難しくなるだけですよ？
No.1さんの回答が分からないうちは、無理だと思います。
まぁ
＞20×20×20×20の80000通りになります
は16万通りの間違いですが。
ー＊－＊－＊－＊－
整数において
十進法は1桁で10個の種類がある(0～9)
十進法は2桁で10*10個の種類がある(0～99)
十進法は3桁で10*10*10個の種類がある(0～999)
ー＊－＊－＊－＊－
D列を右から第1桁めとして3つの種類がある。
C列を右から第2桁めとして3つの種類があるとして、D列とあわせて3*3種類できる
B列を右から第3桁めとして3つの種類があるとして、C～D列とあわせて3*3*3種類できる
A列を右から第4桁めとして3つの種類があるとして、B～D列とあわせて3*3*3*3種類できる
ー＊－＊－＊－＊－
ランダムっていう場合
D列を右から第1桁めとして2つの種類がある。
C列を右から第2桁めとして5つの種類があるとすると、D列とあわせて5*2種類
B列を右から第3桁めとして3つの種類があるとすると、C～D列とあわせて3*5*2種類
A列を右から第4桁めとして2つの種類があるとすると、B～D列とあわせて2*3*5*2種類
ー＊－＊－＊－＊－
>>=INDEX(A:A,MOD((ROW(A1)-1)/3^(4-COLUMN(A1)),3)+1)
は各桁数(各列の行数)が同じ場合しか対応していません。
そのほうが単純にできるからです。
ランダムの場合、それぞれの列に合うような作りになるため、上記の場合が理解できないようでは、提示する気はありません。

頑張れば一つの数式でできるのかもしれませんが。

No.7 回答者： 30246kiku 回答日時： 2015/10/08 07:40

＃４です

> 空白は無視する、なんて事できるのでしょうか？

そう変更量は多くありません
空白は無視するので、とびとびでも

※ 列には１つ以上の空白では無い
SpecialCells(xlCellTypeConstants) で取得できるものがあること
（数式ではなく、値で埋まっていること：数式は対象外に）


Public Sub Samp2()
　　Dim rng As Range, r As Range
　　Dim i As Long, j As Long, k As Long
　　Const CCOLR As String = "D" ' A ～ この列まで

　　Application.ScreenUpdating = False
　　With Columns(CCOLR)
　　　　k = .Column
　　　　.Offset(, 1).Resize(, k + 2).ClearContents
　　　　.SpecialCells(xlCellTypeConstants) _
　　　　　　.Copy .Offset(, k + 1).Cells(1)
　　　　Set rng = .Offset(, k + 1).CurrentRegion
　　End With
　　For i = k - 1 To 1 Step -1
　　　　j = 0
　　　　For Each r In Columns(i).SpecialCells(xlCellTypeConstants)
　　　　　　With rng.Offset(j * rng.Rows.Count)
　　　　　　　　If (j > 0) Then rng.Copy .Cells(1)
　　　　　　　　.Columns(1).Offset(, -1) = r
　　　　　　End With
　　　　　　j = j + 1
　　　　Next
　　　　Set rng = rng.CurrentRegion
　　Next
　　Application.ScreenUpdating = True
End Sub

この回答へのお礼

再度の回答を頂き、ありがとうございます。

やってみたところ、無事出来ました。
普段は数学や数式と無縁な生活をしていますので、教えて頂き大変助かりました。

ありがとうございました。

お礼日時：2015/10/09 23:28

No.5 回答者： CoalTar 回答日時： 2015/10/06 18:15

数式では限界かな～とか思いつつ F1セルに

=INDEX(A:A,MOD((ROW(A1)-1)/3^(4-COLUMN(A1)),3)+1)
右へ、下へオートフィル

この回答へのお礼

回答ありがとうございます。

数式のやっている事が理解できなくて、よろしければ列と行がランダムに増加した時の対応方法を教えて頂けませんでしょうか。

お礼日時：2015/10/07 22:05

No.4 回答者： 30246kiku 回答日時： 2015/10/06 17:06

VBA ですが良いでしょうか

Rows.Count を超えた時にはポンとなります
それまでは、A1 の CurrentRegion を処理対象として結果を出力します
5 x 5、4 x 6、9 x 3　・・・ でも


Public Sub Samp1()
　　Dim rng As Range, r As Range
　　Dim i As Long, j As Long, k As Long

　　Application.ScreenUpdating = False
　　With Range("A1").CurrentRegion
　　　　k = .Columns.Count
　　　　.Offset(, k + 1).Resize(, k + 1) _
　　　　　　　　　　.EntireColumn.ClearContents
　　　　With .Columns(k)
　　　　　　.Copy .Offset(, k + 1)
　　　　　　Set rng = .Offset(, k + 1).CurrentRegion
　　　　End With
　　　　For i = k - 1 To 1 Step -1
　　　　　　j = 0
　　　　　　For Each r In .Columns(i).Cells
　　　　　　　　With rng.Offset(j * rng.Rows.Count)
　　　　　　　　　　If (j > 0) Then rng.Copy .Cells(1)
　　　　　　　　　　.Columns(1).Offset(, -1) = r
　　　　　　　　End With
　　　　　　　　j = j + 1
　　　　　　Next
　　　　　　Set rng = rng.CurrentRegion
　　　　Next
　　End With
　　Application.ScreenUpdating = True
End Sub


※ これは先月他サイトで回答したものになります

Ａ１～Ａ５、Ａ１～Ｄ５まで一つのセルに１桁の数値があります。
http://detail.chiebukuro.yahoo.co.jp/qa/question …

この回答へのお礼

回答ありがとうございます。

うーん・・・・さすがマクロです、
やっている事は解らないのですが、結果は見事に出来ました。

それで、例えばこの表が８×７×４×３×4×５などとなった場合はどこを改変すれば良いでしょうか？
お手数ですが、教えて頂けませんでしょうか。

よろしくお願いいたします。

お礼日時：2015/10/07 22:14

No.3 回答者： mike_g 回答日時： 2015/10/06 14:31

セル F1 に次式を入力して、此れを右方に(セル F1 まで)ズズーッドラッグ＆ペーストした後に、範囲 F1:I1 を下方に(数値の 1 が出る直前にストップ！)ズズーッとドラッグ＆ペースト

=OFFSET($A$1,MOD((ROW(A1)-1)/3^(4-COLUMN(A1)),3),COLUMN(A1)-1,)

【お断り】苦手な“講釈”は割愛しました。

この回答へのお礼

回答いただきありがとうございます。
ばっちり出来ました・・・・が、私にはどうやっているのか理解できそうもありません。

今回の３×４では無く、例えば８×８になった時はどのように対応したら良いでしょうか？
お手数ですが、教えて頂けませんでしょうか。

よろしくお願いいたします。

お礼日時：2015/10/07 22:09

No.2 回答者： mike_g 回答日時： 2015/10/06 11:18

激辛王さん、

「合計で12通り、12行になるはず」が解せません。
貴方が考える「12通り」とやらの残り僅か４通りを書き出してください。
私を「なるほど、そういうことかぁ～」と納得させてください。

この回答へのお礼

3の4乗ですね　すみません。

お礼日時：2015/10/06 13:09

No.1 回答者： 翻車魚 回答日時： 2015/10/06 03:14

長くなります

覚悟してください
理由は質問が間違った条件を示しているのでそれを訂正することと
最後に示す数式を自身で修正できるようにするためです
前置きはこのくらいで条件の訂正について書きます

そもそも条件が不定ですので答えられません

縦方向に３パターン、横方向に４種類なら
３×３×３×３の８１通りになります
しかし、実は縦方向に３パターンではなく20パターンの入力ができるとしたら
20×20×20×20の80000通りになります

縦方向に３パターン、横方向に４種類と意図した質問であれば１行に入力されたパターンを進数と見なすとよい
入力されるのは記号ではなく数値と考えると分かりやすいでしょう（2進数とか10進数とか16進数の進数）

質問の例では３進数の4桁で示すことのできる数のパターン数ということになる
縦方向に10パターン、横方向に４種類であれば10進数の4桁で示すことのできる数のパターンは
10×10×10×10の10000通りになるのは理解できると思います

この考え方ならば列ごとに異なるパターンで入力されるとしても最大の入力パターンは計算できます
A列に３パターン、B列に５パターン、C列に２パターン、D列に１６パターンなら
３×５×２×１６＝480通りと言うことになる


では本題の数式について
私なら上のような考え方で
ROW関数でセルの行数を求めその値を元に数学的な処理をして各桁に数値を割り振り
振り分けられた数字に対して入力される文字を割り付けます
MOD(ROW(A1)-1,桁のパターン数)+1
※これが基本
　 何をやっているのかよく考えて理解してください
CHOOSE関数でパターンを割り当てる
CHOOSE(MOD(ROW(A1)-1,桁のパターン数)+1,パターン１,パターン2,…)

1桁目＝CHOOSE(MOD(ROW(A1)-1,１桁目のパターン数)+1,1桁目のパターン１,1桁目のパターン2,…)
2桁目＝CHOOSE(MOD(INT(ROW(A1)-1/(１桁目のパターン数),２桁目のパターン数)+1,2桁目のパターン１,2桁目のパターン2,…)
3桁目＝CHOOSE(MOD(INT(ROW(A1)-1/(１桁目のパターン数*２桁目のパターン数),３桁目のパターン数)+1,3桁目のパターン１,3桁目のパターン2,…)
4桁目＝CHOOSE(MOD(INT(ROW(A1)-1/(１桁目のパターン数*２桁目のパターン数*３桁目のパターン数),４桁目のパターン数)+1,4桁目のパターン１,4桁目のパターン2,…)
・
・
・
と必要なだけ「1行目」に作る

この数式を入力した列（E列とかD列）を選択して必要な行までコピーする（質問の例なら81行まで）

【注意！！】
縦方向に９パターン、横方向に９種類であれば、
９×９×９×９×９×９×９×９×９で387,420,489通りになります
これはちょっと現実的ではありません
そもそもExcel2007以降のバージョンでは最大1,048,576行までしか使えないのです
（Excel2007よりも前のバージョンでは16,384列まで）

この回答へのお礼

すみません、理解不能でした。
回答いただきありがとうございます。

お礼日時：2015/10/07 22:15