何度もすいません。ExcelのVBAの作成に関して、再度お力いただければ幸いです。

できるだけポイントをお贈りしたいと思います。
こちらのファイルを参照いただけるとわかりやすいと思います。
http://www.geocities.jp/yukitsun001/question.xls

『今、行ないたいのは、オレンジのセルの箇所にのみ、「ある数値」をVBAマクロ
 を実行することで投入することです。』

オレンジのセルは、今現在は300個あると思いますが変動します。今、横軸と縦軸が
いずれも1から25までありますが、軸のメモリがあるところまでが対象です。
横軸と縦軸の長さはいつも同値で、すなわち表は常に正方形になります。
オレンジのセルは対角線(左上から右下)を境に上部にあたるエリアはすべて
オレンジセルとなります。
横軸と縦軸のメモリは1から始まりNまでです。Nは100以下の自然数です。

「ある数値」に関してはExcelのファイルの方に記述致します。

皆様のアドバイス大変助かっております。
どうぞよろしくお願い致します☆

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2004/06/14 21:09:14
  • 終了:--

回答(5件)

id:ozonepapa No.1

いろは おぞね 回答回数288ベストアンサー獲得回数02004/06/14 23:29:05

ポイント50pt

Excelファイルを置いておきました。

Excelの関数には、Cellの中でしか使えないものがあるのでしょうか?

HypGeomDist(a, b, c, d)関数をVBAの式の中に書くとエラーになってしまいます。

行き詰まり、セルA6におくことにしました。

引数aは、セルa5に置いています。

この1行がうまく行かず

 Rem h = h + HypGeomDist(a, b, c, d)

以下の2行に書き換えています

Cells(5, 1) = a

h = h + Cells(6, 1)

以下が、VBAマクロになります

Function func1() As Integer

Dim a As Integer

Dim b As Integer

Dim c As Integer

Dim d As Integer

b = Cells(1, 1)

c = Cells(2, 1)

d = Cells(3, 1)

r = Rnd()

a = 0

h = 0

Do

Rem h = h + HypGeomDist(a, b, c, d)

Cells(5, 1) = a

h = h + Cells(6, 1)

a = a + 1

Loop While h < r

func1 = h

End Function

Sub sub1()

Dim i As Integer

Dim j As Integer

Dim N As Integer

N = 25

For i = 1 To N

For j = i + 1 To N

Cells(i + 12, j + 1) = func1()

Next j

Next i

End Sub

id:miku1973

ありがとー☆

やってみますね♪

2004/06/15 09:13:35
id:cline No.2

cline回答回数60ベストアンサー獲得回数02004/06/14 23:45:32

ポイント50pt

http://www.sigoto.co.jp/excel/

Excel全開VBA

URLはVBAの教則ページです。

とりあえずやってみました。

以下のVBAマクロを”挿入>標準モジュール”で作成した標準モジュールにコピーしてください。

使い方は後述。

※もしかしたら一部の文字がはてなの機能で全角にされているかもしれません

※マクロ名はTestMacroです。適当に書き替えてください

Option Explicit

Sub TestMacro()

Dim StCol, EdCol As Integer

Dim StRow, EdRow As Integer

Dim b, c, d As Integer

Dim x, y As Integer

’入力範囲の探査(軸の目盛りの探査)

StCol = ActiveCell.Column

StRow = ActiveCell.Row

EdCol = StCol

Do

EdCol = EdCol + 1

Loop Until Cells(StRow, EdCol).Value = ””

EdCol = EdCol - 1

EdRow = StRow

Do

EdRow = EdRow + 1

Loop Until Cells(EdRow, StCol).Value = ””

EdRow = EdRow - 1

StCol = StCol + 1

StRow = StRow + 1

If (EdCol <= StCol) Or (EdRow <= StRow) Then

MsgBox (”グラフの左上端が選択されていません”)

Exit Sub

End If

’超幾何分布関数 引数取得

b = Cells(1, 1).Value

c = Cells(2, 1).Value

d = Cells(3, 1).Value

’オレンジ色セル(色番号40)の計算

For y = StRow To EdRow

For x = StCol To EdCol

If Cells(y, x).Interior.ColorIndex = 40 Then

Cells(y, x) = HypGeomDist(b, c, d)

End If

Next

Next

End Sub

’変形超幾何分布関数

Function HypGeomDist(b, c, d As Integer) As Double

Dim a As Integer

Dim ans, r As Double

a = 0

ans = 0

Do

r = Rnd

ans = ans + WorksheetFunction.HypGeomDist(a, b, c, d)

If ans >= r Then

HypGeomDist = ans

Exit Do

Else

a = a + 1

End If

Loop While a <= WorksheetFunction.Min(b, c, d)

End Function

URLはVBAの教則ページです。

◆使い方

・miku1973さんの作成したグラフの左上(横軸と縦軸の目盛りが交差する青いところ)を選択する

・登録したマクロを走らせる

・オレンジ色のセル(色番号40番)に値が書き込まれる

※マクロの実行時に正しいセルを選択していない場合、メッセージが出て終了します

※計算セルの範囲を広げたい場合は目盛りの数を増やしてください。自動的に範囲を認識します。

URLはVBAに関する便利ページです。

◆改造の手引き

・セルに名前を付けてforeach

・値を書き込むセルの色をオレンジ色から別の色に変えたい場合、マクロの

If Cells(y, x).Interior.ColorIndex = 40 Then

の部分を書き替える必要があります。

私の認識が間違っている部分、使い方でわからない部分があれば、いわしでお願いします。

id:miku1973

ありがとう!

あ、今回はたまたまわかりやすいようにオレンジのセルにしたんだけど、本当は色がないんだけど大丈夫かな?

2004/06/15 09:14:54
id:wan2ree No.3

wan2ree回答回数12ベストアンサー獲得回数02004/06/15 03:30:12

ポイント50pt

http://www.hatena.ne.jp/1087214954

何度もすいません。ExcelのVBAの作成に関して、再度お力いただければ幸いです。 できるだけポイントをお贈りしたいと思います。 こちらのファイルを参照いただけるとわかり.. - 人力検索はてな

Functionモジュール

Function HYP(b As Integer, c As Integer, d As Integer)

Dim r As Double

Dim Sum As Double

Dim ta As Integer

Dim a As Integer

a = Application.WorksheetFunction.Min(b, c, d)

ta = 0

Randomize

r = Rnd

Sum = Application.WorksheetFunction.HypGeomDist(ta, b, c, d)

Do While Sum <= r And ta <= a

ta = ta + 1

Sum = Sum + Application.WorksheetFunction.HypGeomDist(ta, b, c, d)

Loop

HYP = Sum

End Function

aは、↓のでその最大値を確定しておいたほうがいいとは思いますが、

Functionとして別ので使うかもなことを考えたら、bcdの最小値をaの最大値として取る方がいいとも思い、引数bcdにしてます

オレンジセルへの展開モジュール

Sub オレンジセルへの展開モジュール()

Dim b As Integer, c As Integer, d As Integer

Dim Count As Integer

Dim i As Integer, j As Integer

Dim Sum As Double

Worksheets(”回線数算出”).Select

Cells(12, 256).End(xlToLeft).Select

Count = Selection.Column - 1

b = Cells(1, 1)

c = Cells(2, 1)

d = Cells(3, 1)

For i = 1 To Count

For j = 1 To Count

If Cells(12 + i, 1 + j).Interior.ColorIndex = 40 Then

Cells(12 + i, 1 + j) = HYP(b, c, d)

End If

Next j

Next i

End Sub

説明で確定してないところ、以下のようにしてます。

”回線数算出”シート、A12セルから縦横に表があるとして、

オレンジセルに値代入するのは、各セルでRnd取ったr以上(なので、aが大きくなってHYPGEOMDISTを足していくのはr未満)の場合

id:miku1973

皆様ありがとうございました。多少自分なりに改良させていただきまして、無事できました。本来は勉強して自己解決しなければいけないと思うのですが、上司オーダーで納期も早く、やむなく相談させていただきました。ありがとうございました!!

2004/06/17 15:13:21

質問者が未読の回答一覧

 回答者回答受取ベストアンサー回答時間
1 cline 60 50 0 2004-06-15 10:23:48
2 いろは おぞね 288 260 0 2004-06-15 12:25:13

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません