none
エクセル VBA 引数に四角くないセル領域を選ぶ VBA ユーザー定義関数 RRS feed

  • 質問

  • Excel 2010/Windows 7です。

    2つのセル範囲の数字の合計が一致するかどうか調べるため2つの引数を設けたエクセルVBAユーザー定義関数を作りました。第1引数に最初のグループの数字のセルを選択して、第2引数に比べたいグループの数字のセルを選択します。第2引数の数字はプラスマイナスのサインが逆になるように合計されますので2つの引数の合計が0なら合計は一致すると言う考えです。 以下がコードです。

    Public Function Gyaku(myRng As Range, myRng2 As Range) As Variant

    Dim Original As Variant
    Dim Opposite As Variant

    Original = Application.WorksheetFunction.Sum(myRng)
    Opposite = Application.WorksheetFunction.Sum(myRng2) * -1
    Gyaku = Original + Opposite

    End Function

    便利だと思って使っていたら本日大きなことに気がつきました。この引数にはセルの範囲は四角く選ばなくてはならず、たとえばCtrlで離れたセルを選ぶと#VALUE!になってしまうことに気がつきました。

    SUMを使っているのでワークシート関数のようにCtrlで離れた複数のセルを選べるのだとばっかり思っておりました。

    このような場合、引数を四角く選ばなくても合計してくれる方法はあるのでしょうか?

    Unionとか引数の数を増やすとかいろいろ考えたのですが、実力不足でここから応用をするのが難しい状態になっております。

    もしよろしかったらご教授いただけたら幸いです。


    LiLi803

    2014年1月16日 4:07

すべての返信

  • Range型はAreasプロパティを持っています。AreasはRangeの配列(のようなもの)になっています。このAreasに含まれている側のRangeが1つの「四角」に対応し、複数の「四角」を選択している場合はそれらをまとめるRangeオブジェクトが作られます。

    # というヒントで解決可能ですか?

    2014年1月16日 4:18
  • Range型はAreasプロパティを持っています。AreasはRangeの配列(のようなもの)になっています。このAreasに含まれている側のRangeが1つの「四角」に対応し、複数の「四角」を選択している場合はそれらをまとめるRangeオブジェクトが作られます。

    # というヒントで解決可能ですか?

     佐祐理様:

     ヒントをありがとうございます。 実はVBAでユーザー定義関数を作ったのはこれが初めてです。

     VBAは初心者でAreasというプロパティーも始めて知りました。 もう少し以下のヒントを組み合わせて解決できるか考えてみます。

    *離れた複数のセル範囲の選択にはAreasというプロパティを使う。

    *わたしのしようとしていることはCtrlキーを押したまま複数の離れたセル範囲を選択し(四角く選ぶとは限らない)その合計を求める。

    もしどうしてもお手上げだったらまた戻らせてください・・・。(><) よろしくお願いいたします。


    LiLi803


    • 編集済み LiLi803 2014年1月16日 6:03
    2014年1月16日 6:03
  • Range型はAreasプロパティを持っています。AreasはRangeの配列(のようなもの)になっています。このAreasに

    まず上記のリンクをクリックしましたが、ここでつまずいております。このサンプルコードを

    'Declaration
    ReadOnlyPropertyAreasAsAreasGet
    'Usage
    DiminstanceAsRangeDimvalueAsAreasvalue = instance.Areas

    以下のように砕いてみましたがPropertyが間違っています。になってしまいました。(Invalid use of Property)

    Sub AreasTotal()

    Dim instance As Range
    Dim value As Areas

    Set instance = Selection

    value = instance.Areas

    MsgBox value

    End Sub

    少なくとも以下はできました。

    Sub AreasTotal()


    Dim N As Integer

    N = Selection.Areas.Count


    MsgBox N


    End Sub

    これですと四角くないセル群をCtrlで選び実行するとちゃんとAreasの数をMsgBoxで取得することができます。しかし、いくら取得できてもこれはAreasが何個あるか・・・ということしか選べません。そのひとつひとつのセルの値の合計・・・からはほど遠いです。

    Areasの個数を値にする・・・。うーん・・・。どうすればいいんだろう。まずセルを選択し、その後In Each cellにするのか・・・。

    まず恐れ入りますがもう一つヒントをいただけますか? AreasのPropertyを使用して値を取得することはできますでしょうか・・・。 なるべく自分の力でやろうとは思うのですが、もう一日中実験してもどうしてもAreasの個数から値を取ることができませんでした。

    もしよろしかったらご教授いただけると幸いです。



    LiLi803

    2014年1月17日 4:48
  • 毎日コードを書き続けています。今日はFor Eachを使ってみました。 もしよろしかったら方向性だけでも少しはましになってきたか、それともまったく的を得ない方向に進んでるかアドバイスいただけると幸いです。

        

    Public Function GyakuEach3(myRng As Range, myRng2 As Range) As Variant

    Dim Original As Variant
    Dim Opposite As Variant

    Set myRng = Selection
    Dim singleArea As Range

    If myRng.Areas.Count = 1 Then

    Original = Application.WorksheetFunction.Sum(myRng)

    Else
        For Each singleArea In myRng.Areas

    Original = 0

    Original = Original + Application.WorksheetFunction.Sum(singleArea)

        Next

    End If

    Set myRng2 = Selection
    Dim singleArea2 As Range

    If myRng2.Areas.Count = 1 Then

    Opposite = Application.WorksheetFunction.Sum(myRng2) * -1

    Else
    Opposite = 0

        For Each singleArea2 In myRng2.Areas

    Opposite = Opposite + Application.WorksheetFunction.Sum(singleArea2)


        Next

    End If

    Opposite = Opposite * -1


    GyakuEach3 = Original + Opposite


    End Function


    LiLi803

    2014年1月18日 6:56
  • EXCELの仕様上無理でしょう。

    EXCELのワークシート関数の仕様では、複数のセル範囲を関数に渡そうとすると、一つ目の四角範囲が一つ目の引数(myRng)、二つ目の四角範囲が二つ目の引数(myRng2)に入ってしまいます。
    そのため、複数の四角範囲で構成される複合範囲を渡そうとしても渡すことができなくなります。
    例えば、1つ目に2個の四角範囲で構成される範囲、2つ目に1つの四角範囲を渡そうとすると、引数を3個受けられる関数が必要となります。
    #関数に範囲を渡す前段階で失敗するのですから、VBA関数内で小細工することすら不可能なのです。

    どうしてもこのユーザー定義関数を使いたいというのであれば、

    1. 複数の範囲を一つにまとめるユーザー関数を作って、その結果をGyaku関数に渡す
    2. Range型ではなく文字列でセル範囲を受ける関数を経由してGyaku関数に渡す

    という回避方法があり得ます。
    #2つの範囲を区別することができる値を途中で渡すことで範囲を区別できるようにする方法もあるけどさらに面倒です

    '方法1 最大30個の範囲を1つの範囲に結合する
    '複雑なセル範囲を渡すには別の関数で範囲を結合してから渡す
    '例 : =Gyaku(Uni(A1:B2,C3),Uni(D4,D6:D7))
    'こんな面倒な渡し方するぐらいなら=SUM(A1:B2,C3)-SUM(D4,D6:D7)を呼ぶほうが楽です
    Public Function Uni(ByVal r0 As Range, Optional ByVal r1 As Range, Optional ByVal r2 As Range, Optional ByVal r3 As Range, Optional ByVal r4 As Range, Optional ByVal r5 As Range, Optional ByVal r6 As Range, Optional ByVal r7 As Range, Optional ByVal r8 As Range, Optional ByVal r9 As Range, Optional ByVal r10 As Range, Optional ByVal r11 As Range, Optional ByVal r12 As Range, Optional ByVal r13 As Range, Optional ByVal r14 As Range, Optional ByVal r15 As Range, Optional ByVal r16 As Range, Optional ByVal r17 As Range, Optional ByVal r18 As Range, Optional ByVal r19 As Range, Optional ByVal r20 As Range, Optional ByVal r21 As Range, Optional ByVal r22 As Range, Optional ByVal r23 As Range, Optional ByVal r24 As Range, Optional ByVal r25 As Range, Optional ByVal r26 As Range, Optional ByVal r27 As Range, Optional ByVal r28 As Range, Optional ByVal r29 As Range) As Range
        'SUM関数が最大30個の範囲を受けられるのは引数が省略可能(optional)のおかげです
    Dim r(30) As Range Set r(0) = r0 Set r(1) = r1 Set r(2) = r2 Set r(3) = r3 Set r(4) = r4 Set r(5) = r5 Set r(6) = r6 Set r(7) = r7 Set r(8) = r8 Set r(9) = r9 Set r(10) = r10 Set r(11) = r11 Set r(12) = r12 Set r(13) = r13 Set r(14) = r14 Set r(15) = r15 Set r(16) = r16 Set r(17) = r17 Set r(18) = r18 Set r(19) = r19 Set r(20) = r20 Set r(21) = r21 Set r(22) = r22 Set r(23) = r23 Set r(24) = r24 Set r(25) = r25 Set r(26) = r26 Set r(27) = r27 Set r(28) = r28 Set r(29) = r29 Dim i As Integer For i = 0 To 29 If Not (r(i) Is Nothing) Then If (Uni Is Nothing) Then Set Uni = r(i) Else Set Uni = Union(Uni, r(i)) End If End If Next End Function '質問者の関数 Public Function Gyaku(myRng As Range, myRng2 As Range) As Variant Dim Original As Variant Dim Opposite As Variant Original = Application.WorksheetFunction.Sum(myRng) Opposite = Application.WorksheetFunction.Sum(myRng2) * -1 Gyaku = Original + Opposite End Function '方法2 範囲指定を文字列で渡すことで複合セル範囲を計算できるようにする '例 : =Gyaku2("A1:B2,C3" ,"D4,D6:D7") '行や列が移動しても参照しているセルの文字列は自動で変更されないので使いづらいです Public Function Gyaku2(ByVal rs1 As String, ByVal rs2 As String) As Variant Dim myRng As Range Dim myRng2 As Range Dim index As Integer Set myRng = Range(rs1) Set myRng2 = Range(rs2) Gyaku2 = Gyaku(myRng, myRng2) End Function
    #WorksheetFunction.Sumは複合範囲になっていても計算してくれるのでAreasで分解する必要はありません

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    2014年1月18日 11:13
  • gekka様

    お返事は下のほうになります。恐れ入りますがスクロールお願いいたします。

    EXCELの仕様上無理でしょう。

    EXCELのワークシート関数の仕様では、複数のセル範囲を関数に渡そうとすると、一つ目の四角範囲が一つ目の引数(myRng)、二つ目の四角範囲が二つ目の引数(myRng2)に入ってしまいます。
    そのため、複数の四角範囲で構成される複合範囲を渡そうとしても渡すことができなくなります。
    例えば、1つ目に2個の四角範囲で構成される範囲、2つ目に1つの四角範囲を渡そうとすると、引数を3個受けられる関数が必要となります。
    #関数に範囲を渡す前段階で失敗するのですから、VBA関数内で小細工することすら不可能なのです。

    どうしてもこのユーザー定義関数を使いたいというのであれば、

    1. 複数の範囲を一つにまとめるユーザー関数を作って、その結果をGyaku関数に渡す
    2. Range型ではなく文字列でセル範囲を受ける関数を経由してGyaku関数に渡す

    という回避方法があり得ます。
    #2つの範囲を区別することができる値を途中で渡すことで範囲を区別できるようにする方法もあるけどさらに面倒です

    '方法1 最大30個の範囲を1つの範囲に結合する
    '複雑なセル範囲を渡すには別の関数で範囲を結合してから渡す
    '例 : =Gyaku(Uni(A1:B2,C3),Uni(D4,D6:D7))
    'こんな面倒な渡し方するぐらいなら=SUM(A1:B2,C3)-SUM(D4,D6:D7)を呼ぶほうが楽です
    Public Function Uni(ByVal r0 As Range, Optional ByVal r1 As Range, Optional ByVal r2 As Range, Optional ByVal r3 As Range, Optional ByVal r4 As Range, Optional ByVal r5 As Range, Optional ByVal r6 As Range, Optional ByVal r7 As Range, Optional ByVal r8 As Range, Optional ByVal r9 As Range, Optional ByVal r10 As Range, Optional ByVal r11 As Range, Optional ByVal r12 As Range, Optional ByVal r13 As Range, Optional ByVal r14 As Range, Optional ByVal r15 As Range, Optional ByVal r16 As Range, Optional ByVal r17 As Range, Optional ByVal r18 As Range, Optional ByVal r19 As Range, Optional ByVal r20 As Range, Optional ByVal r21 As Range, Optional ByVal r22 As Range, Optional ByVal r23 As Range, Optional ByVal r24 As Range, Optional ByVal r25 As Range, Optional ByVal r26 As Range, Optional ByVal r27 As Range, Optional ByVal r28 As Range, Optional ByVal r29 As Range) As Range
        'SUM関数が最大30個の範囲を受けられるのは引数が省略可能(optional)のおかげです
    Dim r(30) As Range Set r(0) = r0 Set r(1) = r1 Set r(2) = r2 Set r(3) = r3 Set r(4) = r4 Set r(5) = r5 Set r(6) = r6 Set r(7) = r7 Set r(8) = r8 Set r(9) = r9 Set r(10) = r10 Set r(11) = r11 Set r(12) = r12 Set r(13) = r13 Set r(14) = r14 Set r(15) = r15 Set r(16) = r16 Set r(17) = r17 Set r(18) = r18 Set r(19) = r19 Set r(20) = r20 Set r(21) = r21 Set r(22) = r22 Set r(23) = r23 Set r(24) = r24 Set r(25) = r25 Set r(26) = r26 Set r(27) = r27 Set r(28) = r28 Set r(29) = r29 Dim i As Integer For i = 0 To 29 If Not (r(i) Is Nothing) Then If (Uni Is Nothing) Then Set Uni = r(i) Else Set Uni = Union(Uni, r(i)) End If End If Next End Function '質問者の関数 Public Function Gyaku(myRng As Range, myRng2 As Range) As Variant Dim Original As Variant Dim Opposite As Variant Original = Application.WorksheetFunction.Sum(myRng) Opposite = Application.WorksheetFunction.Sum(myRng2) * -1 Gyaku = Original + Opposite End Function '方法2 範囲指定を文字列で渡すことで複合セル範囲を計算できるようにする '例 : =Gyaku2("A1:B2,C3" ,"D4,D6:D7") '行や列が移動しても参照しているセルの文字列は自動で変更されないので使いづらいです Public Function Gyaku2(ByVal rs1 As String, ByVal rs2 As String) As Variant Dim myRng As Range Dim myRng2 As Range Dim index As Integer Set myRng = Range(rs1) Set myRng2 = Range(rs2) Gyaku2 = Gyaku(myRng, myRng2) End Function
    #WorksheetFunction.Sumは複合範囲になっていても計算してくれるのでAreasで分解する必要はありません

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    お返事をいただけて心より感謝しております。

    >EXCELの仕様上無理でしょう。

    と、仰られましたが、わたしにとってほぼ望むとおりの動きをするコードをいただきました。 感動しております。

    まず、Uni関数を使用しました。

    完璧です。 四角くく囲めない黄色のセル値の合計とオレンジのセル値の合計は同じ値です。Uni関数をGyakuに合わせて使えば簡単に黄色のセルの合計とオレンジのセルの合計が一致していることがダイアログボックスでわかります。式の結果が0なのですから。 Uni関数を入力することは少しも手間だとは思いません。今まではわざわざ電卓でそれぞれの数字を足して、紙に書いて、同じ額かいちいち調べていたのですからそれに比べれば格段の効率向上になりました。 それぞれの合計がいくらか・・・というのはあまり重要でなく、いくら差額があるのか・・・というのが一番重要な使い方ですので、この使用法で完璧です。(この手の作業がえんえんと1日続くのです・・・)

    方法2のほうも完璧にできました。その画像を貼りたいのですが、画像は2つまでしか貼れないというので画像は貼りません。セル番地を入れるのは大変かもしれませんが、関数が可能であることがわかったことは大きなプラスですし、今一度コードを読んでしっかり勉強します。

    さて、もう一つの画像なのですが、以下になります。本当に恐れ入りますが、この一つをご質問させていただいてよろしいですか?

    理由はわからないのですが、時々以下の緑の枠で囲まれた表示が変な表示になります。小数点とEが合わさった表示になります。2つとも変になったり、一つだけ変になったりします。上の画像の例ですと両方とも0ですので、即座に合計が一致することがわかるのですが、Eが入った長い小数点の数字になるといったい0なのか0ではないのか即わからず困っております。 法則がよくわからずマイナス値を含むセルが入っているとそうなるかと思いましたが、マイナス値が入っていてもそうならないときがあります。多分わたしの変数のデータ型が間違っているからなのだと思いますが、どうにかこのEと小数点の表示がでないようにすることはできますでしょうか? 一生懸命データ型を変えているのですがなかなかなおりません。 もし、よろしかったらアドバイスいただけると幸いです。ありがとうございます・・・。



    LiLi803

    2014年1月19日 1:36
  • たぶん浮動小数点で計算するために僅かに誤差が出てしまっているんだと思います。

    検索するとこの手の問題の理由の解説はたくさん見つかります

    Excel で浮動小数点演算の結果が正しくない場合がある
    「Excel SUM 誤差」

    人間が計算すると10進数を使い極端に異なる桁同士での計算なども考慮しますが、コンピューターでの計算は2進数で計算し桁数も有限の範囲でしか扱えないため、どうしても誤差が発生することを回避することができないのです。

    微小な数値が無視できたほうがよいのであれば、Gyaku関数内でRound等で必要桁数に丸めてしまうのも手です。


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    2014年1月19日 4:31
  • たぶん浮動小数点で計算するために僅かに誤差が出てしまっているんだと思います。

    検索するとこの手の問題の理由の解説はたくさん見つかります

    Excel で浮動小数点演算の結果が正しくない場合がある
    「Excel SUM 誤差」

    gekka様:

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

    エクセルにこのような誤差の問題があることをまったく知りませんでした。 原因は100%、Gyaku関数でわたしが宣言した変数のデータ型のせいだと思っておりましたのでちゃんと検索せず質問してしまって申し訳ございませんでした。今後は解説などを読みながら対策法を考えていこうと思います。

    gekka様にUni関数を頂いたのですが、少しでも自分で理解をしようとコードを一生懸命読むようにしております。まだエクセルVBAを始めて7ヶ月ぐらいですので以下のことは知りません。

    配列 

    値渡しで引数を渡す 

    複数の引数を渡す 

    ByBalとは何か? 

    Is Nothingとは何か? 

    Union

    Uni関数は上記の使用が山盛りになっておりますので上記のことは自分で勉強して理解するように致します。 

    ただ、一つだけご質問させていただいてよろしいでしょうか?

    gekka様のコードの一部
    Dim i As Integer

    For i = 0 To 29 If Not (r(i) Is Nothing) Then If (Uni Is Nothing) Then Set Uni = r(i) Else Set Uni = Union(Uni, r(i)) End If End If Next

    ではIf Not・・・Thenの下に作業ではなく、またIf ...Thenが来ています。

    そしてその下にEnd Ifが2回・・・。自分は教科書に載っているような構文しかわからないのですが、If構文の下に、直接Ifを持ってくることは可能なのでしょうか?

    このことを理解するためにデバックでステップインで実行し、コードの流れを読もうと思いました。Ifに入ったらどういう順番でIfを処理しているのか見ようと思ったからです。 しかし、これも今日知ったのですが、Function Subにはブレークポイントが効かないんですね。(効くかもしれませんが私のやり方が間違っているのかもしれません。)

    ですからUni Function Subを下のように普通のSubに変換してブレークポイントをつけて実行しましたが、やはりうまく行きませんでした。

    もしよろしかったら教えていただきたいのですが、

    1.デバック機能のブレークポイントはSubプロシージャのみに使えてFunctionプロシージャには使えないものなのでしょうか?

    インターネットで検索してみたのですが、そのような質問が見つかりませでした。 すみません・・・。

    Public Sub Unis()
        
    Dim r0 As Range, r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range, r9 As Range, r10 As Range, r11 As Range, r12 As Range, r13 As Range, r14 As Range, r15 As Range, r16 As Range, r17 As Range, r18 As Range, r19 As Range, r20 As Range, r21 As Range, r22 As Range, r23 As Range, r24 As Range, r25 As Range, r26 As Range, r27 As Range, r28 As Range, r29 As Range
        
    Uni As Range
        
        
        Dim r(30) As Range
        Set r(0) = r0
        Set r(1) = r1
        Set r(2) = r2
        Set r(3) = r3
        Set r(4) = r4
        Set r(5) = r5
        Set r(6) = r6
        Set r(7) = r7
        Set r(8) = r8
        Set r(9) = r9
        Set r(10) = r10
        Set r(11) = r11
        Set r(12) = r12
        Set r(13) = r13
        Set r(14) = r14
        Set r(15) = r15
        Set r(16) = r16
        Set r(17) = r17
        Set r(18) = r18
        Set r(19) = r19
        Set r(20) = r20
        Set r(21) = r21
        Set r(22) = r22
        Set r(23) = r23
        Set r(24) = r24
        Set r(25) = r25
        Set r(26) = r26
        Set r(27) = r27
        Set r(28) = r28
        Set r(29) = r29

        Dim i As Integer
        For i = 0 To 29
         If Not (r(i) Is Nothing) Then
            If (Uni Is Nothing) Then
                Set Uni = r(i)
            Else
                Set Uni = Union(Uni, r(i))
            End If
         End If
        Next
    End Sub



    LiLi803


    • 編集済み LiLi803 2014年1月20日 0:37
    2014年1月20日 0:35

  • そしてその下にEnd Ifが2回・・・。自分は教科書に載っているような構文しかわからないのですが、If構文の下に、直接Ifを持ってくることは可能なのでしょうか?

    IF~ELSE~END IF , For~Next , Do While ~ Loopなどの内側には同様にIF~ELSE~END IF , For~Next , Do While ~ Loopを入れ子にすることが可能です。

    1.デバック機能のブレーク
    できます。
    ワークシートからこの関数が呼び出されるとブレークできます。
    ワークシートの式をちょと書き換える等してみてください。

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    2014年1月20日 3:59

  • gekka様:

    1.デバック機能のブレーク

    できます。
    ワークシートからこの関数が呼び出されるとブレークできます。
    ワークシートの式をちょと書き換える等してみてください。

    そうだったんですか!(0o0)/;;; 目からうろこです。こんなことも知らずに申し訳ございません。今までFunctionはデバッグが使えないと思い込んでました。上記のようにしたらローカルウィンドウもウォッチウインドウもステップインもちゃんとできました。ありがとうございます。

    IF~ELSE~END IF , For~Next , Do While ~ Loopなどの内側には同様にIF~ELSE~END IF , For~Next , Do While ~ Loopを入れ子にすることが可能です。

    ブレークポイントをもうけてステップインをしましたら最初の2回りはすぐ下のIfに行って、それからはまたいで実行されたようですが、完全に理解はできませんでした。でもFunctionでブレークポイントもデバッグもできることがわかったことは大きな収穫でしたので、これからも勘に頼らずじっくりとデバックを利用するようにこころがけます。IFなどのステートメントについては今は自分に配列等の知識がなくても練習の場所はいくらでもあるはずです。もっとコードを書き込む練習をして入れ子もトライしてみます。

    初心者でとんでもない質問ばかりして恐れ入ります。辛抱強くお答え下さって深く感謝しております。

    又こちらに尋ねることがありましたらよろしくお願いいたします。



    LiLi804



    • 編集済み LiLi804 2014年1月20日 5:50
    2014年1月20日 5:49