人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

何度もすいません。ExcelのVBAの作成に関して、再度お力いただければ幸いです。
できるだけポイントをお贈りしたいと思います。
こちらのファイルを参照いただけるとわかりやすいと思います。
http://www.geocities.jp/yukitsun001/question.xls

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

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

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

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

●質問者: yoshifuku
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:Excel VBA にの アドバイス エリア
○ 状態 :終了
└ 回答数 : 3/5件

▽最新の回答へ

1 ● ozonepapa
●50ポイント

http://ozone.dip.jp/ozonepapa/question.xls

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

◎質問者からの返答

ありがとー☆

やってみますね♪


2 ● cline
●50ポイント

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

http://www.vbalab.net/

VBA質問箱

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

◆使い方

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

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

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

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

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

http://www2s.biglobe.ne.jp/~iryo/

ExcelVBA便利帳

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

◆改造の手引き

・セルに名前を付けてforeach

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

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

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

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

◎質問者からの返答

ありがとう!

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


3 ● wan2ree
●50ポイント

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未満)の場合

◎質問者からの返答

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ