こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

EXCEL VBAでできるでしょうか?

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

例)A
  B
  C
  D...と項目は何個になるか未定の場合、別な印刷用のシートなどに、
  AはBに対してどの位影響があると思いますか?
  AはCに対してどの位影響があると思いますか?
  AはDに対してどの位影響があると思いますか?
  BはAに対してどの位影響があると思いますか?
  BはCに対してどの位影響があると思いますか?
  BはDに対してどの位影響があると思いますか?

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

投稿日時 - 2003-06-19 21:12:37

QNo.579768

すぐに回答ほしいです

質問者が選んだベストアンサー

#4、6です。

>”データのある列”をセルB5
>”出力”がSheet2のセルC4の場合

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

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


Option Explicit
Sub test()

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

Const strOutputSheet As String = "Sheet2" '出力シート
Const lngOutputCol As Long = 3 '出力列(C列に出力)
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 'B列のデータ最終行を取得
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

投稿日時 - 2003-06-21 08:43:57

お礼

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

投稿日時 - 2003-06-22 08:54:04

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.6

こんにちは。
#4です。

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

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

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

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

投稿日時 - 2003-06-20 08:57:48

補足

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

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

投稿日時 - 2003-06-21 07:27:42

ANo.5

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

投稿日時 - 2003-06-20 06:43:05

お礼

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

投稿日時 - 2003-06-22 08:55:07

ANo.4

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


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

たとえば、

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

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

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

とすればできますよ。

投稿日時 - 2003-06-20 00:16:14

補足

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

投稿日時 - 2003-06-20 06:20:30

ANo.3

エクセルVBAだから出きると言う部分は、画面表示機能
だけです。CでもVBでもロジックは変らないと言うことです。
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
と出ました。
5個にすると
A-B
A-C
A-D
A-E
B-C
B-D
B-E
C-D
C-E
D-E
となりました。
 ABCDE
A*
B *
C  *
D   *
E    *
の桝目表を作り、対角線より下の3角形部分の組み合わせが出ればよいのでしょう。
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とすればやや一般化できます。配列の値のセット
もABC・・・であれば、プログラムでやれます。
後は「-」を「は」にa(j)の後に「に対してどの位影響があると思いますか? 」を””でくくり、&でくっ付ければ好いです。

投稿日時 - 2003-06-19 22:19:56

お礼

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

投稿日時 - 2003-06-20 06:28:26

ANo.2

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

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

投稿日時 - 2003-06-19 21:27:25

ANo.1

できます。

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

投稿日時 - 2003-06-19 21:22:35

補足

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

投稿日時 - 2003-06-20 06:10:48

あなたにオススメの質問