No.4ベストアンサー
- 回答日時:
#1、2、cjです。
#1、2、補足欄へのレスです。取り急ぎ、コードのみ修正しました。
#2を元に書き換えています。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rSrc As Range
Application.EnableEvents = False
Set rSrc = Range("B2").CurrentRegion
Application.EnableEvents = True
If Intersect(Target, rSrc) Is Nothing Then Exit Sub
Application.EnableEvents = False
Call PrintCombi(rSrc)
Application.EnableEvents = True
End Sub
Sub PrintCombi(ByVal rSrc As Range)
Dim tnFld As Long
Dim nRc As Long
Dim nConti As Long
Dim nRow As Long
Dim i As Long
Dim j As Long
tnFld = rSrc.Columns.Count
nConti = 1
With rSrc(1, rSrc.Columns.Count + 3)
.CurrentRegion.Clear
Cells(1).Resize(, tnFld).Copy .Cells(1)
For i = tnFld To 1 Step -1
nRc = Cells(Rows.Count, i).End(xlUp).Row
nRow = 2
For j = 2 To nRc
Cells(j, i).Copy Destination:=.Cells(nRow, i).Resize(nConti)
nRow = nRow + nConti
Next j
nConti = nConti * (nRc - 1)
Next i
With .Cells(2, 1).Resize(nConti)
For i = 2 To tnFld
Range(.Cells(1, i), .Cells(.Cells.Count + 1, i).End(xlUp)).Copy Destination:=.Columns(i)
Next i
End With
End With
End Sub
No.3
- 回答日時:
横1列に並んだ6個(A~E列の列数+1)の適当な未使用のセルを作業用セルとして使用します。
ここでは仮に、M1~R1を作業用セルとして使用するものとします。
まず、R1セルに
1
と入力して下さい。
次に、Q1セルに次の関数を入力して下さい。
=MAX(IF(COUNTIF(E:E,"*?"),MATCH("*?",E:E,-1),1),IF(COUNT(E:E),MATCH(MAX(E:E)+1,E:E),1))
次に、Q1セルをコピーして、M1~P1の範囲に貼り付けて下さい。
次に、K1セルに次の関数を入力して下さい。
=IF(ROWS($1:1)>PRODUCT($M$1:$Q$1),"",IF(INDEX(E:E,MOD(INT((ROWS($1:1)-1)/PRODUCT(R$1:$R$1)),Q$1)-ROW(E$1)+2)="","",INDEX(E:E,MOD(INT((ROWS($1:1)-1)/PRODUCT(R$1:$R$1)),Q$1)-ROW(E$1)+2)))
次に、K1セルをコピーして、G1~J1の範囲に貼り付けて下さい。
次に、K1~J1の範囲をコピーして、同じ列の2行目以下に貼り付けて下さい。
以上です。
No.2
- 回答日時:
#1、cjです。
ちょっとミスしましたので、コードの差し替えをお願いします。
加えて、
> 右側、1列挟んで右側に、全通りの組合わせを
> 作成します。
この部分の説明ですが、
右側、2列挟んで右側に、全通りの組合わせを
作成します。
というようにしないと、列を追加しながらの作成がうまく行きませんでした。
実際に試す際も、予め、入力範囲の右側に2列の空列がある状態から
始めるようにしてください。
失礼しました。
' ' ここから
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rSrc As Range
Application.EnableEvents = False
Set rSrc = Range("B2").CurrentRegion
Application.EnableEvents = True
If Intersect(Target, rSrc) Is Nothing Then Exit Sub
Application.EnableEvents = False
Call PrintCombi(rSrc)
Application.EnableEvents = True
End Sub
Sub PrintCombi(ByVal rSrc As Range)
Dim tnFld As Long
Dim nRc As Long
Dim nConti As Long
Dim nRow As Long
Dim i As Long
Dim j As Long
tnFld = rSrc.Columns.Count
nConti = 1
With rSrc(1, rSrc.Columns.Count + 3)
.CurrentRegion.Clear
For i = tnFld To 1 Step -1
nRc = Cells(Rows.Count, i).End(xlUp).Row
nRow = 1
For j = 1 To nRc
Cells(j, i).Copy Destination:=.Cells(nRow, i).Resize(nConti)
nRow = nRow + nConti
Next j
nConti = nConti * nRc
Next i
With .Resize(nConti)
For i = 2 To tnFld
Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)).Copy Destination:=.Columns(i)
Next i
End With
End With
End Sub
' ' ここまで
この回答への補足
cj_mover さん!
変更したい箇所があるので、補足入力しました。
どうか気づいてください・・・><
コードの差し替えのご連絡ありがとうございます。
No.1
- 回答日時:
こんにちは。
VBAですが、なるべく基本的な書き方にしました。
適用したいシートを表示して、
シートタブを右クリック、[コードの表示]をクリック、
表示された白いシート(VBEのシートモジュール)に
下記をコピペして
Alt + F11 キーでExcelに戻ります。
以降、A1から連続したセル範囲を書き換える度に、
右側、1列挟んで右側に、全通りの組合わせを
作成します。
' ' ここから
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rSrc As Range
Application.EnableEvents = False
Set rSrc = Range("B2").CurrentRegion
Application.EnableEvents = True
If Intersect(Target, rSrc) Is Nothing Then Exit Sub
Application.EnableEvents = False
Call PrintCombi(rSrc)
Application.EnableEvents = True
End Sub
Sub PrintCombi(ByVal rSrc As Range)
Dim tnFld As Long
Dim nRc As Long
Dim nConti As Long
Dim nRow As Long
Dim i As Long
Dim j As Long
tnFld = rSrc.Columns.Count
nConti = 1
With rSrc(1, rSrc.Columns.Count + 2)
.CurrentRegion.Clear
For i = tnFld To 1 Step -1
nRc = Cells(Rows.Count, i).End(xlUp).Row
nRow = 1
For j = 1 To nRc
Cells(j, i).Copy Destination:=.Cells(nRow, i).Resize(nConti)
nRow = nRow + nConti
Next j
nConti = nConti * nRc
Next i
With .Resize(nConti / nRc)
For i = 3 To tnFld
Range(.Cells(1, i), .Cells(1, i).End(xlDown)).Copy Destination:=.Columns(i)
Next i
End With
End With
End Sub
' ' ここまで
この回答への補足
cj_mover さま、ご回答ありがとうございます。
完璧にできました!!
恐れ入りますが追加希望がございまして。
1行目は項目を入れたいので、参照したくありません。
いただいたものを編集してみようと思ったのですが、スキがなくて、わかりません。。。。
2行目以降からスタートという風に書き換えるにはどうすればよろしいでしょうか?
またこの質問に気づいていただけることを祈って。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルについて教えてください。 2 2023/06/14 11:11
- Visual Basic(VBA) VBA ドロップダウンリストを残して値のみクリア 2 2022/10/27 05:42
- Excel(エクセル) Excelにの以下の設定方法について教えてください! C列にデータ入力の設定をしています。(出、入を 3 2022/06/22 01:33
- その他(データベース) Accessフォームからパラメーターで表示したレコードを指定のExcelのセルへ転送する方法について 2 2022/08/22 18:04
- Excel(エクセル) エクセル 条件に合う日付に入力された時間数の合計したい 4 2022/06/17 22:18
- Excel(エクセル) Excelについて Excel初心者です。 日報に数字を入力する時、誤った数字を入れると、セルが赤く 6 2023/03/31 17:05
- Excel(エクセル) Excelの機能に関してです ドロップダウンリストをB3セルに設定します 元データはB3~B1000 2 2023/07/22 09:20
- Excel(エクセル) 結合セルのソートについて 5 2022/04/22 11:57
- Visual Basic(VBA) 【VBA】Excelで罫線を引きたい 3 2022/07/14 12:04
- Excel(エクセル) 関数EXACT(文字列,文字列)とexcelVBA 3 2022/04/14 15:07
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
Excelでの全通りの組み合わせ出力方法(文字列)
Excel(エクセル)
-
エクセルで重複しない組み合わせ出力方法
Excel(エクセル)
-
Excelでの全通りの組み合わせ出力方法2
Excel(エクセル)
-
-
4
Excelですべての組合せ(重複組合せ)を出力するには?
Visual Basic(VBA)
-
5
エクセルVBA 全ての組み合わせを作る
Excel(エクセル)
-
6
Excelマクロでのデータ全通り組み合わせ出力方法
Excel(エクセル)
-
7
エクセルでnCr (組み合わせ)の作成方法
Excel(エクセル)
-
8
「○○通りのパターンがある」の計算のしかた
数学
-
9
組み合わせをexcelでマトリクス化したい
教育ソフト・学習ソフト
-
10
Excelでロト6の数字を決めたい
Excel(エクセル)
-
11
複数の数字の組み合わせの中から合計がAになる組み合わせを探す方法
Excel(エクセル)
-
12
ロト6の組み合わせをExcelを使って表にランダムの数字で抽出する方法
数学
-
13
エクセルでランダムにチーム分けをしたいです。
Windows Vista・XP
-
14
エクセルで重複しない組み合わせの出し方
Excel(エクセル)
-
15
有無、要否、賛否、是非、可否、当否…これらの言葉について
その他(教育・科学・学問)
-
16
Excelでセル参照したとき、書式も一緒に持ってくるには?
Windows Vista・XP
-
17
エクセルで決められた合計になる組み合わせを作成
その他(ソフトウェア)
-
18
ビジネスの文書における、数字の半角、全角は?
その他(ビジネス・キャリア)
-
19
エクセルで順列の列挙
Excel(エクセル)
-
20
ExcelVba 有効なセルかどうかを判定するには
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
行数が不規則な一週間ごとの合...
-
文字列になっている時間をVBAで...
-
ある列、或いは、ある行のセル...
-
マクロの有効化するダイヤログ...
-
【マクロ】フォルダからエクセ...
-
Excelでの時間帯の入力
-
excel で二つのどちらかを選ぶ
-
エクセルの順位別一覧表の自動...
-
Excel 2019 のピボットテーブル...
-
エクセル 価格表から単価を呼び...
-
excelの不要な行の削除ができな...
-
エクセルで特定の範囲内から小...
-
シートAで横に並んだ項目→シー...
-
Excelが固まってしまった。
-
Excel2013のF6キー操作について
-
【関数】スペースがいくつ入っ...
-
Excelはなんで先頭の0を消すん...
-
【Microsoft Office Excel Comp...
-
西暦や和暦の表示をyyyymmdd表...
-
別シートからの文字を変更
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 2019 のピボットテーブル...
-
[関数得意な方]教えて下さい・...
-
Excelにてある膨大なデータを管...
-
[関数について]わかる方教えて...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセル関数に詳しい方教えて...
-
INDIRECTを使わず excelで複数...
-
[オートフィルタ]で抽出された...
-
エクセルの神よ、ご回答を! エ...
-
エクセル関数に詳しい方、教え...
-
各ページの1番上の表示について
-
Excelで写真のような表を作った...
-
エクセルで不等号記号(≠)が上に...
-
数学 Tan(θ)-1/Cos(θ)について...
-
Excel 2019 は、SPILL機能があ...
-
Excelで全角を半角にしたいので...
-
条件付き書式を教えてください
-
Excel フィルターを掛けた状態...
-
[オートフィルタ]の適用範囲の...
おすすめ情報