• ベストアンサー

AccessVBAでユーザー定義関数使用

エクセルVBAで、以下のユーザー定義関数(選択したセルaを全て3乗した和を求める)を使用していますが、アクセスVBAで同様の関数を使用するにはどうしたらよいでしょうか? ★アクセスVBVで実行したいプログラム 実行すると"データテーブル"の"Aフィールド"を全て3乗した和をmsgboxで表示 ★エクセルで使用していたユーザー定義関数 ’-------------------------------------- Function y(a As Range) As Variant Dim r As Range Dim result As Variant For Each r In a result = result + r.Value ^ 3 Next y = result End Function ’-------------------------------------- ぞうぞよろしくお願い致します。

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

  • ベストアンサー
noname#22222
noname#22222
回答No.2

VBA となると、書き方は人それぞれです。 私は、DBCount関数を利用しています。 -------------------------------------------------------------------- MsgBox DBCount("SELECT Sum([A]^3) AS こたえ FROM データテーブル;") ? DBCount("SELECT SUM(ID) FROM インポート記録") 243856 ? DBCount("SELECT SUM(ID^3) FROM インポート記録") 14161272936256 -------------------------------------------------------------------- Public Function DBCount(ByVal strQuerySQL As String) As Variant On Error GoTo Err_DBCount    Dim N    Dim rst As ADODB.Recordset    Set rst = New ADODB.Recordset    With rst      .Open strQuerySQL, _         CurrentProject.Connection, _         adOpenStatic, _         adLockReadOnly      If Not .BOF Then        .MoveFirst ' <-- 省略可!        N = Nz(.Fields(0), 0)      End If    End With Exit_DBCount: On Error Resume Next    rst.Close    Set rst = Nothing    DBCount = N    Exit Function Err_DBCount:    MsgBox "SELECT 文の実行時にエラーが発生しました。(DBCount)" & Chr$(13) & Chr$(13) & _       "・Err.Description=" & Err.Description & Chr$(13) & _       "・SQL Text=" & strQuerySQL, _       vbExclamation, " 関数エラーメッセージ"    Resume Exit_DBCount End Function

hiroshi77777
質問者

お礼

回答ありがとうございました。

その他の回答 (1)

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.1

モジュール化すれば下記のようになります。 --- Sub y() Dim rs As New ADODB.Recordset Dim SQL As String SQL = "SELECT Sum([A]^3) AS こたえ FROM データテーブル;" rs.Open SQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic MsgBox rs.Fields("こたえ") rs.Close End Sub

hiroshi77777
質問者

お礼

回答ありがとうございました。

関連するQ&A

  • エクセルユーザー定義関数(1)

    エクセル初心者です。 複数のセル範囲(例えばRange("A1:A100"))を入力させ、入力されたセル範囲すべてのセルを3乗した総和を求めるユーザー定義関数は作ること可能でしょうか? Function Y(a As Range) As Variant ここに、aで選択されたセル全てを3乗して総和を求める関数Yを定義したい。 End Function よろしくお願い致します。

  • エクセル 複数シート( VLOOKUP ユーザー定義関数

    複数シート(範囲)を指定できるVLOOKUP関数をユーザー定義で作りたいと思ってます。下記のコードではうまく動かないので教えてください。 Function VLOOKUPM(検索値 As Variant, 対象シート As String, 対象セル As Range, 列番号 As Integer) As Variant Dim i As Integer Dim r As Range Dim sh As Variant Application.Volatile sh = Split(対象シート, ",") For i = 0 To UBound(sh) Set r = Sheets(sh(i)).Range(対象セル) If 検索値 = r Then VLOOKUPM = r.Offset(0, 列番号) Exit Function End If Next End Function

  • ユーザー定義関数の再計算

    ユーザー定義関数を作りました。 ところが、この関数が自動再計算をしてくれません。 どうしたら自動再計算するようになるのでしょうか? よろしくお願いします。 ちなにこの関数は、自分のシートのB2とsheet1~sheet4のB9を比較して、正しければB9の4つ右のセルの値を合計して返すものです。 =SheetLook($B$2,"sheet1,sheet2,sheet3,sheet4",B9,4) コードです。 Function SheetLook(参照元 As Variant, 比較対象シート As String, 比較対象セル As Range, 参照セル位置 As Integer) As Variant   Dim i As Integer   Dim rng As Range   Dim sss As Variant   Dim kei As Variant   Dim cnt As Integer   sss = Split(比較対象シート, ",")   kei = 0   cnt = 0   For i = 0 To UBound(sss)     Set rng = Sheets(sss(i)).Range(比較対象セル.Address)     If 参照元 = rng Then       kei = kei + rng.Offset(0, 参照セル位置)       cnt = cnt + 1     End If   Next   If cnt <> 0 Then     SheetLook = kei   Else     SheetLook = ""   End If End Function

  • 指定した範囲内の値を結合するユーザ定義関数

    いつもお世話になっています。VBA初心者です。 指定した範囲内(開始セルと終了セルを指定)に入力された値を結合するユーザ定義関数を作成しようと思い、以下のようなコードを書いたのですが、実行すると「#VALUE!」のエラーになってしまいます。 ウォッチ式を見たところ、Range(startCell, endCell)の部分がEmpty値になっているようなのですが、どうしてこれがダメなのかわかりません。 どなたか解説していただけないでしょうか。 よろしくお願いしたします。 Function joinValue(startCell As Range, endCell As Range) As Variant Dim myResult As Variant For Each myResult In Range(startCell, endCell) myResult = myResult.Value & myResult.Value Next joinValue = myResult End Function

  • 【VBA】ユーザ定義関数が動かない

    【VBA】ユーザ定義関数が動かない 下記のようなプログラムをVBEの標準モジュールに記述して、 ワークシートの適当なセルに「=tc("aa","bb")」と入力してEnterを押した所 セルの表示が「=tc("aa","bb")」となってしまい狙った効果が得られません。 本当は、「aabb」と表示させたいのですが、なぜうまくいかないのでしょうか。 ご教授願います。 ◆関数の仕様  引数1と引数2に入力された文字列を連結して返り値として返す。 ◆コード Function tc(str1 As Range, str2 As Range) As String Dim Str As String Str = str1.Value & str2.Valuett tt = Str End Function

  • Excelマクロで定義の関数実行結果が#VALUE

    以前にマクロの記述について教えて頂いた件の再度の質問になります. Excelマクロで複素数を扱う関数を下記HPから標準モジュールに コピペしました.今度は正しくコピーできていると思います. しかし,計算結果がどうしても「#VALUE!」となってしまいます.何故でしょうか? どなたか助けて頂けませんか! http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 今回は関数定義の「 IMMULT」関数に関する部分に絞っています. ここまで絞ってもエラーになるのは,単純な問題なのでしょうか? 行列の積を求めるマクロの手順にも問題はなさそうです. Public Function IMPRODUCTa(ParamArray a()) As Variant IMPRODUCTa = Application.Run("atpvbaen.xlam!IMPRODUCT", a) End Function Public Function IMSUMa(ParamArray a()) As Variant IMSUMa = Application.Run("atpvbaen.xlam!IMSUM", a) End Function Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If c1 = r2 Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function

  • Excel VBA ユーザー定義関数をイベントマクロで使用する

    Excel VBA ユーザー定義関数をイベントマクロで使用する Excel2003を使用しています。 あるセルと同色に塗りつぶされたセルの値を合計したく、下記1のユーザー定義関数を作成しました。 このユーザー定義関数を下記2のイベントプロシージャ内で呼び出して使用したいのですが、可能でしょうか? 可能であれば、どのようにコードを書いたらいいでしょうか? Call を使用するのかな?と思い、コードを追加してみましたが、引数の型が一致しないといった内容のエラーメッセージが表示されてしまいました。 よろしくお願いします。 ------------------------------------------------------------- 1.ユーザー定義関数(同色セルの合計) Function SumColor(hanni As Range, iro As Range) As Double   Dim myrng As Range   SumColor = 0    For Each myrng In hanni     If myrng.Interior.ColorIndex = iro.Interior.ColorIndex Then      SumColor = SumColor + myrng.Value     End If    Next myrng End Function 2.イベントマクロ(C列3行目以下ダブルクリックで塗りつぶし) Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)   If Target.Column = 3 And Target.Row >= 34 Then    Range(Cells(Target.Row, 3), Cells(Target.Row + 1, 38)).Interior.ColorIndex = 36   End If End Sub

  • 関数の引数に複数のユーザ定義型変数を使いたい

    一つの関数の一つのパラメータが異なるユーザ定義型を受けられるようにしたいのですが、どのようにすればいいのでしょうか? Public Type TypeA strCodeA As String intNumA As Integer End Type Public Type TypeB strCodeB As String intNumB As Integer End Type Public Function funcTest(arg1 As Variant) As Integer (略) End Function と記述して関数を Dim datA As TypeA iResult = funcTest(datA) と呼び出そうとすると、次のようなエラーメッセージが表示されて進みません。 コンパイルエラー: パブリックオブジェクトモジュールで定義されたユーザー定義型に限り、変数に割り当てることができ、実行時バインディングの関数に渡すことができます。

  • ユーザー定義関数をボタンに登録したい

    数式のエラーを回避するユーザー定義関数を作りPERSONAL.xlsに登録しました。 その後アドインに保存して、関数の挿入ダイアログボックスのユーザー定義関数から選んで使用していますが、頻繁に使用するのでボタンに登録したいのです。 どのようにすればいいのでしょうか? ネットで検索して色々やってみてるのですが分かりません。 ボタンのマクロの登録で「PERSONAL.xla!vlookupエラー回避」と直接打ち込んで登録してみましたが、実際にボタンをクリックすると「コンパイルエラー End Subが必要です」というエラーメッセージが出ます。 どこをどうすればいいのか教えてください。よろしくお願いします。 Sub vlookupエラー回避() ' ' vlookupエラー回避 Macro ' マクロ記録日 : 2006/7/25 ユーザー名 : ******** ' Function myVLookup(Rg As Range, Area As Range, col As Integer, opt As Integer) Dim vlk As Variant vlk = Application.VLookup(Rg, Area, col, opt) If IsError(vlk) Then vlk = "" End If myVLookup = vlk End Function

  • エクセルマクロで定義した関数が動きません

    以前にマクロの記述について教えて頂いた件の続きになります. ご指導頂いたとおりExcelマクロで複素数を扱う関数を下記HPから 標準モジュールにコピペしました.今度は正しくコピーできたと思いますが, 実行するとエラーになります. 標準の組込み関数を用いて「実数」の行列を計算すれば正しく 計算できますが,当然ながら「複素数」は計算できません. この「複素数」を扱う新しく定義した関数が動かない理由, 「End if に対するifブロックがありません」とか 計算結果が「#VALUE!」となってしまうのは何故でしょうか? マクロの記述内容はほとんど理解できないのですが, どなたか助けて頂けませんか! ちなみにエクセルは2016版です. http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 以下はコピー定義した「 IMMULT」関数と「 IMINVERS」関数のマクロです. Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 'End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function

専門家に質問してみよう