ＥＸＣＥＬ ＶＢＡでできるでしょうか？

質問

アンケートの簡単に調査票を作るために、EXCELのＶＢＡで作ることできるでしょうか？

例）Ａ
　　Ｂ
　　Ｃ
　　Ｄ...と項目は何個になるか未定の場合、別な印刷用のシートなどに、
　　ＡはＢに対してどの位影響があると思いますか？
　　ＡはＣに対してどの位影響があると思いますか？
　　ＡはＤに対してどの位影響があると思いますか？
　　ＢはＡに対してどの位影響があると思いますか？
　　ＢはＣに対してどの位影響があると思いますか？
　　ＢはＤに対してどの位影響があると思いますか？

　と、いうような組み合わせのを表示させたいのですが...。同じ項目の場合（ＡとＡなどのような）は表示させないようにしたいのですが、複雑になるのであれば、表示してもかまいません。このようなことがＶＢＡでできるのか、それが簡単なのか難しいことなのかさえまだ勉強中でよくわかりません。すみませんが教えてください。

回答No.7

happypoint · ベストアンサー

#4、6です。

＞”データのある列”をセルＢ５
＞”出力”がSheet２のセルＣ４の場合

前回とコードを見比べて、
どこが変わったのか、調べてみてください。

なお、データ項目はＢ５から下方向に、
縦１列に入力されていると想定してあります。

Option Explicit
Sub test()

'定数の設定
Const strInputSheet As String = "Sheet1" 'データ項目のあるシート
Const lngInputRow As Long = 5 'データ項目の開始行
Const lngInputCol As Long = 2 'データ項目のある列（Ｂ列）

Const strOutputSheet As String = "Sheet2" '出力シート
Const lngOutputCol As Long = 3 '出力列（Ｃ列に出力）
Const lngOutputRow As Long = 4 '出力開始行

Const strMessageA As String = " は "
Const strMessageB As String = " に対してどの位影響があると思いますか？"

'定義
Dim lngMaxRow As Long
Dim lngCountA As Long
Dim lngCountB As Long
Dim strA As String
Dim strB As String
Dim lngRow As Long

'項目数を把握
Sheets(strInputSheet).Select
Cells(ActiveSheet.Rows.Count, lngInputCol).Select
Selection.End(xlUp).Select

lngMaxRow = Selection.Row 'Ｂ列のデータ最終行を取得
lngRow = lngOutputRow '出力開始行の設定

'項目Aをなめる
For lngCountA = lngInputRow To lngMaxRow
　strA = Cells(lngCountA, lngInputCol).Value '項目Aの取得

　'項目Bをなめる
　For lngCountB = 1 To lngMaxRow

　　If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない
　　　strB = Cells(lngCountB, lngInputCol).Value '項目Bを取得
　　　Sheets(strOutputSheet).Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合
　　　lngRow = lngRow + 1 '改行する
　　End If

　Next lngCountB
Next lngCountA

End Sub

お礼

本当に色々細かく質問に答えていただき、ありがとうございました。これで作業もはかどりそうです。活用させていただきます！

回答No.6

happypoint

こんにちは。
#4です。

＞Ａ１やＢ１の組み合わせを自動的に選んでくれること
＞項目数の変化にもやはり自動的に対応してくれること

こんな感じでどうでしょうか。

コードを書いてみました。
標準モジュールに貼り付けてテストしてみてください。

A列に項目が入力してあると仮定して、
J列に質問文を出力する設定にしてあります。
Const…の行の部分は、定数の設定ですので、代入する数値を実情に応じて変更してください。

順列組み合わせですので、組み合わせの数に注意してください。
項目の組み合わせが65536（Excelの最大行）を超えるとエラーになります。注意してください。

Option Explicit

Sub test()

'定数の設定
Const lngCol As Long = 1 'データ項目のある列（A列の場合は,1）
Const lngOutputCol As Long = 10 '出力列（J列に出力）
Const strMessageA As String = " は "
Const strMessageB As String = " に対してどの位影響があると思いますか？"

'定義
Dim lngMaxRow As Long
Dim lngCountA As Long
Dim lngCountB As Long
Dim strA As String
Dim strB As String
Dim lngRow As Long

'項目数を把握
Cells(ActiveSheet.Rows.Count, lngCol).Select
Selection.End(xlUp).Select
lngMaxRow = Selection.Row
lngRow = 1

'項目Aをなめる
For lngCountA = 1 To lngMaxRow

strA = Cells(lngCountA, lngCol).Value '項目Aの取得

'項目Bをなめる
For lngCountB = 1 To lngMaxRow

If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない
strB = Cells(lngCountB, lngCol).Value '項目Bを取得
Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合
lngRow = lngRow + 1 '改行する
End If

Next lngCountB
Next lngCountA

End Sub

補足

ありがとうございます！！ぜひこれを活用させてもらいたいのですが、初歩的な質問をもう二つさせてもらうと、下の”データのある列”をセルＢ５、”出力”がSheet２のセルＣ４の場合、どういうふうに文字を入れ替えればいいのでしょうか？すみませんが教えてください。

Const lngCol As Long = 1 'データ項目のある列（A列の場合は,1）
Const lngOutputCol As Long = 10 '出力列（J列に出力）

回答No.5

imogasi

＃３です。
a(1)="A"をa(1)=Range("a1")とかにすれば、セルＡ１に入れた値を使います。a(2)以下もおなじです。

お礼

今回はどうもありがとうございました。教えていただいたことは今後参考にさせていただきます。

回答No.4

happypoint

こんばんわ。
これってVBAを使うほどの処理でしょうか？

セルの文字列を「&」でつなぐ方法をご存じですか？

たとえば、

　セルA1に「ネコ」
　セルB1に「イヌ」

がある時、セルC3に
　「ネコはイヌに対してどのくらい影響があると思いますか?」
と表示させるには、

　=A1 & "は" & B1 & "に対してどのくらい影響があると思いますか?"

とすればできますよ。

補足

そのとおりだと思います。でも、上記のＡ１やＢ１の組み合わせを自動的に選んでくれること、また項目数の変化にもやはり自動的に対応してくれること、この２点を考えるとマクロのような気がしたのですが....。

回答No.3

imogasi

エクセルＶＢＡだから出きると言う部分は、画面表示機能
だけです。ＣでもＶＢでもロジックは変らないと言うことです。
Sub test05()
Dim a(4)
a(1) = "A": a(2) = "B": a(3) = "C": a(4) = "D"
K = 1
For i = 1 To 4
For j = i + 1 To 4
Cells(K, "A") = a(i) & "-" & a(j)
K = K + 1
Next j
Next i
End Sub
A列に
A-B
A-C
A-D
B-C
B-D
C-D
と出ました。
５個にすると
A-B
A-C
A-D
A-E
B-C
B-D
B-E
C-D
C-E
D-E
となりました。
　ＡＢＣＤＥ
Ａ＊
Ｂ　＊
Ｃ　　＊
Ｄ　　　＊
Ｅ　　　　＊
の桝目表を作り、対角線より下の３角形部分の組み合わせが出ればよいのでしょう。
Sub test05()
Dim a(5)
a(1) = "A": a(2) = "B": a(3) = "C": a(4) = "D"
a(5) = "E"
K = 1
For i = 1 To UBound(a)
For j = i + 1 To UBound(a)
Cells(K, "A") = a(i) & "-" & a(j)
K = K + 1
Next j
Next i
End Subとすればやや一般化できます。配列の値のセット
もＡＢＣ・・・であれば、プログラムでやれます。
後は「－」を「は」にa(j)の後に「に対してどの位影響があると思いますか？ 」を””でくくり、＆でくっ付ければ好いです。

お礼

ありがとうございます。なんか光が見えてきました！ただ、私の質問の仕方が悪かったのですが、この場合だと項目をマクロに最初から入れていかなくてはだめですよね（"Ａ"、"Ｂ"の部分）。これを自動的に読み取ってくれて、しかも毎回項目の数も変化するような場合のプログラムも可能なんでしょうか？

回答No.2

0shiete

ネットで探されてみてはいかがでしょうか？

参考URL：

http://www.vector.co.jp/vpack/filearea/win95/business/calc/enquate/index.html

回答No.1

0shiete

できます。

が、まず、関数だけでできないかどうか
を検討されることをお勧めします。

補足

項目数が毎回変わってもマクロボタンを押すだけで自動的にできないか、というのが目標でして、関数をシートに入れておくと毎回項目数が変わるたびにその関数自体（例えば項目数の参照範囲など）も変わってしまうのではないかと思ったからです。