• 締切済み

VBAのプログラムについて

以前、どこかのHPで以下のようなVBAのユーザー関数を見つけました。 最近になって、そのプログラムを見返したのですが、何をしているのかさっぱり覚えていません。 どなたか、教えてください。 そもそも、FEIが何の略なのかまたは何なのかわかりません。 ////////////////////////▼プログラム/////////////////////////////////////////// Function FEI(k As Double, Order As Integer) As Double Dim s As Double Select Case Order Case 1 s = (3969 * k ^ 10) / 65536 + (1225 * k ^ 8) / 16384 + (25 * k ^ 6) / 256 + (9 * k ^ 4) / 64 + k ^ 2 / 4 + 1 Case 2 s = -(441 * k ^ 10) / 65536 - (175 * k ^ 8) / 16384 - (5 * k ^ 6) / 256 - (3 * k ^ 4) / 64 - k ^ 2 / 4 + 1 Case Else End Select FEI = Application.WorksheetFunction.pi * s / 2 End Function /////////////////////////////▲ココまで///////////////////////////////////////////////////////

みんなの回答

回答No.1

見た感じ、実験値とか、何かの係数を求めてる感じですね。πが出てきているあたり、何かの角度とかでしょうか。 Excelでグラフを書いて、多項式近似で近似式を求めてから、それをマクロ化するとかすると、こんなユーザ関数を作る人が昔多かったですね。 ただ、引数にkとか使ってたり、65536とかで割るとかして、あえて係数を整数にしているあたり、もしかしたらさらに古い時代(FORTRANとかの時代)の近似式を持ってきているかもしれません。 ご参考まで。

関連するQ&A

  • エクセルVBAのFunctionについて

    エクセル2000です。 以下は、時間を与えれば、それに相当する挨拶が返ってくるFunctionのつもりです。 一応期待通りの働きはしてくれます。 質問は、Functionから ”messe” として返ってくる文字列を、Function内部で生成している、”hmsg”、”mes”、”s”、”kao(i)” にわけて取得できないかということです。 もちろん Functionを複数つくったり、返ってくる文字列”messe”を、”。”の位置を取得してMID関数等で分ければ取得できるのはわかるのですが、そんな手間をかけず、たとえば、MsgBox hmsg のような感じで簡単に ”hmsg”、”mes”、”s”、”kao(i)” それぞれの文字列を取得する方法があったらご教示くださいませ。 Sub test01() MsgBox messe(TimeValue("17:46")) End Sub Function messe(t As Date) As String Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer, n As Integer Dim kao Dim s As String t2 = Hour(t) t3 = Hour(TimeValue(t) + TimeValue("01:00")) m = Minute(t) kao = Split("o(^o^)/,(*^o^*),(*´∇`*),(= ̄▽ ̄=)V,(〃^∇^〃),(=´▽`)ゞ,(^∇^),(〃^∇^)o,ヾ(@⌒ー⌒@)ノ, (#^。^#),o(^-^)o,ヾ(=^▽^=)ノ, \(*^▽^*)/ ,( ̄ー ̄)v", ",") Select Case t2 Case Is < 11: hmsg = "おはようございます。" Case Is < 17: hmsg = "こんにちは。" Case Else: hmsg = "こんばんは。" End Select Select Case m Case Is < 15: mes = t2 & "時を回りましたね。 " Case Is < 30: mes = "もうすぐ " & t2 & "時半になりますね。 " Case Is < 45: mes = t2 & "時半を過ぎてますね。" Case Else: mes = "もうすぐ " & t3 & "時になるんですね。 " End Select Select Case t2 Case 0: s = "とうとう日付が変わりました。 " Case 1, 2, 3, 4: s = "からだに気をつけてね。 " Case 5, 6: s = "朝になっちゃいました。 " Case 7, 8, 9: s = "また一日が始まりましたね。 " Case 10: s = "お昼にはまだもうちょっと・・・。 " Case 11: s = "おなかが空いちゃいました。 " Case 12: s = "お昼ですよ~。 " Case 13: s = "食後は眠くなっちゃいます。 " Case 14: s = "そろそろおやつが欲しいかも。 " Case 15, 16: s = "午後は長いですね。 " Case 17: s = "お疲れさまです。 " Case 18: s = "残業、お疲れさまです。 " Case 19, 20: s = "そろそろ切り上げませんか。 " Case 21, 22: s = "こんな遅くまで大変ですね。 " Case 23: s = "日付が変わっちゃいますよ。 " Case Else: s = "がんばってね。 " End Select Randomize i = Int(Rnd() * 14) messe = hmsg & mes & s & kao(i) End Function

  • VBAでFunctionの使い方

    エクセルのVBAでFunctionの使い方がいまいちよくわかりません。 Function msg() Dim h As Integer h = Hour(Time) Select Case h Case Is < 12: msg = "おはようございます。" Case Is < 17: msg = "こんにちは。" Case Else: msg = "こんばんは。" End Select End Function Sub 挨拶() MsgBox msg End Sub とやってみたら一応正しく動くようですが、これであっているのでしょうか? 他の例などを見るとFunction msg()の()内にも何か入れなければならないようなのですが、わかりません。

  • ExcelのVBAソースコード(一部)の翻訳

    ソースコードの一部ですが、開発者が他界し訊けずにおります。 今後自分でもVBAを勉強しますが、お教えいただけますでしょうか。 なお冒頭は Function process_new(m0 As Integer, m As Integer, d As Variant, ans As Double) As Integer Dim a(501), b(501), s(501), r(501) As Double Dim w(501), g(11), xx As Double Dim s1 As Double Dim k(501) As Integer Dim i, j, flg As Integer でスタートしています。 =(以下、質問内容)==== s1 = s(k(0)) * 1.618 flg = 0 For i = m0 To m - 3 If Not i = k(0) Then If s1 > s(i) Then flg = flg + 1 End If End If Next i =(以上)====

  • EXCEL VBAがうまく動きません。

    指定された rangeの中から2番目に小さい値を検索し、そのセルの行数を求めようとしていますが、えらーが出ます。いくつか試してみましたがだめでした。 初歩的な質問で恐縮ですが、教えてください。 構文は以下のように書きました。 Private Sub test() Dim s As Double Dim r As Range Dim secondsmall As range Dim smallrow as integer r = Worksheets("sheet1").Range("a1:a4") s = WorksheetFunction.Small(r, 2) secondsmall = WorksheetFunction.Find(what:=s) smallrow = secondsmall.row MsgBox smallrow end sub 宜しくお願いします。

  • VBA 変数の使い方について

    皆様、こんばんは。 いつもお世話になっているVBAの初心者です。 今回、いくつかのテキストボックスの値を使った複雑な計算を行うために、変数を使おうとしていますが、うまく動いていません。 書こうとしているプロシージャはこちらです。 Private Sub 発電推計1() Dim My発電量1 As Integer Dim My発電量2 As Integer Dim My発電量3 As Integer Range("N37").Formula = "= (" & My発電量1 & " + " & My発電量2 & " + " & My発電量3 & ") * 10 / 10000" Select Case Range("O18") Case 1 My発電量1 = Range("P18") * 15 * 0.1 / 0.0036   ... End Select Select Case Range("O19") Case 1 My発電量2 = Range("P18") * 15 * 0.1 / 0.0036 ... End Select Select Case Range("O20") Case 1 My発電量3 = Range("P18") * 15 * 0.1 / 0.0036 ... End Select End Sub My発熱量の計算式に間違いがあるでしょうが、どう書けばいいかが分かりません。何方か詳しい方に教えていただければ非常に助かります。 どうぞよろしくお願いいたします。

  • VBA超初心者です

    皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • VBA のメッセージボックスに・・・

    Private Sub CommandButton1_Click() Dim intMsg As Integer Dim x As Double x = Val(Cells(3, 2).Value) / Val(Cells(2, 2).Value) ^ 2 Cells(2, 5) = x intMsg = MsgBox("指数は&x&" & vbCrLf & "&z&です。") Select Case x Case 0 To 18 MsgBox "やせぎみ" Case 19 To 25 MsgBox "普通" Case 26 To 30 MsgBox "太り気味" Case Else MsgBox "危険" End Select End Sub ってプログラムを組んだのですが メッセージボックスに結果が表示されません。 計算して出た値を、メッセージボックス内のxとzで表示させたいのですが・・・ &ではさむ?だけではだめなんですか?

  • ACCESS2000

    Option Compare Database Public Function RoundDown(X As Double, s As Integer) As Double Dim t As Integer t = 10 ^ Abs(s) If s > 0 Then RoundDown = Int(X * t) / t Else RoundDown = Int(X / t) * t End If End Function というモジュールをつかって値の切り捨てをおこなっていましたが、マイナスの値がうまく動きません。 どなたか教えていただけないでしょうか。

  • EXCEL VBA で,プログラムが動かない.

    EXCEL2000のVBAでプログラムを組みました.(下に記す) 数千行に及ぶ数字のデータがあるのですが,20行に1回だけ,いらないデータが3行出てきます.その3行を削除していくプログラムです.Rangeのところで行を選んで欲しいのに,p列とq列を選んでしまうようです.RangeをRowsに変えたらエラーが出ました.こういう場合はどのように書けばいいのでしょうか.誰か教えてください.お願いします. Sub 削除() '20行ごとに入っている3行を削除していく. Dim i As Integer Dim p As Integer Dim q As Integer p = 21           'pの初期値は21 For i = 1 To 500 q = p + 2 r = "p:q" Range(r).Select Selection.Delete shift:=xlUp p = p + 20 Next i End Sub

  • エクセル2010のvbaについて

    押されたコマンドボタンの名前を取得したいです (調べてみましたがエラーになり取得できませんでした) 後コマンドボタンがたくさんあり、コードも長く とても邪魔なので省略したいのですができますか? (左クリックと右クリックで違う処理をした後       MouseDown コマンドボタンの名前で少し処理を変えるコードです) MouseUp (下のコードのような感じです) 回答お願いします Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Select Case Button Case 1 Range("A1") = 1 Case 2 Range("A1") = 2 End Select End Sub Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) If (コマンドボタンの名前を取得) = "aaa" Then Range("A1") = Range("A1") + 1 Else Range("A1") = Range("A1") - 1 End If End Sub

専門家に質問してみよう