[[20160604084417]] 『検証シート作成』(グランパ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『検証シート作成』(グランパ)

 シート名【検証】各工程の表示値が正解か誤りかを検証するマクロをご教示お願いします。
 表示値と直径、全長、柄径、刃長、刃数はあらかじめセットされています。

 工程1の求め方

 工程1=50000/加工数/0.8

 50000と0.8は常に固定で、加工数が直径により変動します。

 加工数の求め方

【検証】のF2の直径を【工程1】のA列とB列の範囲から求め、G2の全長をC列、

 D列、E列から求めます。
 例、直径8.0 全長120の場合 加工数は【工程1】のD7になり、156に
 なります。
 50000/156/0.8=400.641→401となります。

 シート名【検証】
      A      B      C     D  E     F    G     H   I   J
  1 工程名 表示値  検証          直径  全長  柄径  刃長  刃数
  2 工程1  401           8  120    8     20    2
  3 工程2  12.5
  4 工程3   1.88

 シート名【工程1】
       A     B     C       D       F            
  1   min  max   70以下  120以下  300以下 
  2   0.1   0.5   216     144      72      
  3   0.51  2.0   648     432     216
  4   2.01  3.0   504     336     168
  5   3.01  4.0   504     336     168
  6   4.01  6.0   324     216     108
  7   6.01  8.0   234     156      78

 工程2の求め方

 工程2=d+a×直径+b×刃長+c×刃数

【検証】F2の直径を、【工程2】のA列とB列の範囲から求め、そのd a b cを

 上記の式にあてはめます。

 例 直径=8.0  刃長=20   刃数=2
 1.9+0.6×8+0.1×20+1.9×2=12.5になります。

 シート名【工程2】
     A    B       C     D    E     F  
 1  min  max      d     a    b     c
 2  1.0  2.9    10.2   0.5  0.4  -1.3
 3  3.0  13.4    1.9   0.6  0.1   1.9
 4 13.5  20.0  -26.5   3.1  0.2   5.1

 工程3の求め方

 工程3=e+a×直径+b×刃長+c×柄径+d×全長

 シート名【工程3】
     A     B      C       D       E
 1   e     a      b       c       d
 2 -0.2   0.06  -0.01   -0.08   0.017

 例 直径=8.0  刃長=20   柄径=8.0  全長=120
 -0.2+0.06×8+0.01×20+-0.08×8+0.017×120=1.88になります。

 最終【検証】の表示値と検証値に食い違いが出た場合に、メッセージを
 出したいです。

< 使用 Excel:Excel2007、使用 OS:Windows7 >


検証する対象の数値はどうやって計算しているのですか?
外部で作成されたものをあなたが検証するという設定なら、
「あなた」がシート上で確認できるもののほうが良くないですか?
誰かが作ったマクロなら、マクロの検証が必要になってきませんか?

ワークシート上でも、Match関数とIndex関数を上手く使えばできそうに思います。
(データの配列の順序を変える必要があるかもしれませんが。)

どうしてもマクロだということでしたら、今どこまでできていて、
どこに詰まっているのか具体的に示した方がよさそうですね。

(γ) 2016/06/04(土) 11:53


 数式処理案、賛成です。
 もちろん、VBAコード面でのお手伝いは、必要なら他の回答者さんも含めて、なんとでもアドバイスできますけど
 ・NGの場合のメッセージ文字列文言が入るような幅広のセルをつくり、そこに数式。
 ・数式で判定して、検証OKなら 1 、検証NGなら 0 にしたとします。
 ・セルの表示書式で、ユーザー定義 "";"NGの場合のメッセージ"  こうしておいて
 ・条件付書式で セルの値が 0 なら 背景色を赤 といったように設定。

 こんなようにしておけば、検証値が間違っていた場合、即座に、そのセルにメッセージが表示され赤くなる。
 検証値が正しければ空白になりますので、わかりやすいのではないでしょうか。

 この場合の数式ですけど、専門家さんがたくさんおられますから、効率の良い数式の回答が早く寄せられると思いますよ。

(β) 2016/06/04(土) 12:39


 こんにちわ。

 質問の意図が分かりません。

 質問者さんが提示した例を関数で求める方法を知りたいと言う事ですか?

 関数で各工程の結果を求めるなら下の式になります。

 C3セル =ROUND(50000/INDEX(工程1!D2:D7,SUMPRODUCT(FREQUENCY(F3,工程1!B2:B7)*ROW(1:7)))/0.8,0)
 C4セル =INDEX(工程2!C2:C4,SUMPRODUCT(FREQUENCY(F3,工程2!B2:B4)*ROW(1:4)))+
         INDEX(工程2!D2:D4,SUMPRODUCT(FREQUENCY(F3,工程2!B2:B4)*ROW(1:4)))*F3+
         INDEX(工程2!E2:E4,SUMPRODUCT(FREQUENCY(F3,工程2!B2:B4)*ROW(1:4)))*I3+
         INDEX(工程2!F2:F4,SUMPRODUCT(FREQUENCY(F3,工程2!B2:B4)*ROW(1:4)))*J3
 C5セル =工程3!A2+工程3!B2*F3+工程3!C2*I3+工程3!D2*H3+工程3!E2*G3

 この結果を元に、表示値と比較して表示値が間違っていたら、色を付けるとかですか?

 B3〜C5セルを選択 → 条件付き書式 → 数式に =$B3<>$C3 → 書式で好きな背景色を設定

 因みに、工程3の結果は1.48になりますね。
 例の表示値と計算式の結果ではB3セルとC3セルの色が変わります。

 例が間違っているのか、工程3シートのbの係数が間違ってるのかは分かりませんが?
 例では0.01、bの係数は-0.01になっています。

 手計算との比較とかでしたら、上記式で計算された値を使えば良いだけの事ですし、
 γさんが言われるように、表示値は予め外部で算出された結果を貼り付けてるんですか?

(sy) 2016/06/04(土) 15:08


 あっ、マクロで間違い探しでしたね。

 でもマクロでする場合関数に比べて、行番号の取得が簡略される以外のメリットは無さそうですね。

 質問者さんのマクロのレベルにも寄りますが、コード作成の手間や後々のメンテナンスなどを考えると、
 関数と条件付き書式の方が良いと思います。

(sy) 2016/06/04(土) 15:29


 回答者の皆さま、多数のアドバイスありがとうございます。

 外部で作られたものを、私が検証することになりました。
 直径や全長違いで、数万種類の数十万種類?ものサイズがあり、その値に間違いはないかの
 検証です。
 マクロでやるのが一番早く仕事ができるのではないか?と思っています。
 特に習得したいのが工程2で、直径が変わっても対応できるもの(変数を使ったもの)を、
 どうかご教示お願いします。

(グランパ) 2016/06/04(土) 17:46


 マクロで行うなら、まずレイアウトをしっかりと決めないといけません。
 またメッセージをポップアップで表示させた後、どうしたいのか等の、
 手順が明確になっていないといけません。

 単にマクロなら簡単に処理が出来る訳ではありません。
 しっかりと明確な完成イメージが無いとマクロは作成できません。

 関数そのものは要件によっては組み合わせなど非常に難しい面もありますが、
 使い勝手で言えば関数の方が遥かに手軽ですし、自由度も高いです。

 でも関数はセル数が多いと遅くなるので、結果件数が何十万件もあるならマクロの方が良いと思いますが、
 引数のリストの件数は何十万あっても別に関係ありません。

 例のように1件づつ比較するだけのレイアウトなら、マクロで行うメリットはありません。

 マクロで変数を使用してと言う事ですが、ループで何処かに連続で結果を表示させると言う事ですか?

 例とレイアウトが違うのでしたら、何処にどのように結果を表示させるのかを明確に提示して下さい。
 それとまずご自身で何処までの事が出来るのかをお答え下さい。

(sy) 2016/06/04(土) 18:24


 数十万件〜数万件というのは何の件数ですか?
 もしかして 検証シートのF2からJ2に各要素を入れる、そのパターン数ということですか?
 もし、そうであれば

 1.各要素を入力
 2.入力後マクロ実行指示

 1.各要素を入力するだけで結果表示

 どちらが便利ですか?

(β) 2016/06/04(土) 19:07


 <それとまずご自身で何処までの事が出来るのかをお答え下さい。

  工程3 

  Sub 工程3()

      e = -0.2
      a = 0.06
      b = -0.01
      C = -0.08
      d = 0.01

      外径 = Range("F2")
      全長 = Range("G2")
      柄径 = Range("H2")
      刃長 = Range("I2")
      刃数 = Range("J2")

      Range("C4") = e + a * 外径 + b * 刃長 + C * 柄径 + d * 全長

    End Sub

 グランパのスキルは恥ずかしながら、この程度です。

 <数十万件〜数万件というのは何の件数ですか?
 <検証シートのF2からJ2に各要素を入れる、そのパターン数ということですか?

 型番の件数です。

 <1.各要素を入力
 アップした中では省略しましたが、型番を入力すると直径、全長、柄径、刃長、刃数がVlookup
 により、抽出するようになっています。

 <2.入力後マクロ実行指示
    入力後マクロ実行指示になります

(グランパ) 2016/06/04(土) 19:53


 型番をどこにいれるのかのせつめいがありませんが、さておき。

 しつこいようですが、

 A.型番をいれるとVLOOKUPで要素が自動表示され、そこでマクロ実行指示すると、マクロが動いて結果が出る

 これと、

 B.型番をいれるとVLOOKUPで要素が自動表示され、同時に結果が出る。

 だれが考えても、B.が優れていますよね?
 検証すべき型番が何十万件あろうと、検証したい型番を入力する、それは A.も B.も同じですよね?
 何十万件もあるから A.がいいんだという理由がわかりません。

 ちなみに、A.がマクロ処理、B.が関数処理です。

(β) 2016/06/04(土) 20:10


 B.型番をいれるとVLOOKUPで要素が自動表示され、同時に結果が出る。
 Bがいいですねえ。

 素人考えでお手数をかけなのはBと思いました。
 すみません。

(グランパ) 2016/06/04(土) 20:18


 念のためですが、B.の構えをマクロで実現することもできますよ。
 どこかに型番を入れている、その型番入力をトリガーにして自動実行です。

 私自身は関数音痴なので、マクロでのお手伝いならできるのですが、その私から見ても
 みなさんおっしゃっているように数式と条件付書式での処理にしておいたほうが、
 グランパさんにとって あとあと、わかりやすいのではないかなと そう思っているんです。

(β) 2016/06/04(土) 20:35


 βさん、ありがとうございます!

 勉強になるので、マクロを是非ともご教示お願いします。

(グランパ) 2016/06/04(土) 20:41


 どのような方法を取られるのか分かりませんが、私の関数で工程1の式が全長の要素を失念していましたので修正版を載せておきます。

 工程1シートのC1〜E3の値を数値にして、書式設定で0"以下"として下さい。
 そして下の式で直径と全長での結果が求められます。
 C3セル =ROUND(50000/INDEX(工程1!C2:E7,SUMPRODUCT(FREQUENCY(F3,工程1!B2:B7)*ROW(1:7)),SUMPRODUCT(FREQUENCY(G3,工程1!C1:E1)*ROW(1:4)))/0.8,0)

 後数十万件と言うのは型番と言う事ですが、実際に外部から送られてくる検証しなければいけないデータの件数はどれくらいでしょうか?

 その件数が数万件とかあるのであれば、マクロの方が良いと思います。

 ただマクロで行っても例示のレイアウトであれば、速度は期待できません。
 複数のデータを順次自動で判定してくれるだけです。

 レイアウトを変えれば、速度も速くする方法はありますが。

 検証データの件数はどれくらいですか?

(sy) 2016/06/04(土) 22:12


 マクロを書いてみるのはやぶさかではないのですが、syさんもいわれるように、かえって効率が悪くなるような気がします。
 コードもちょっとごちゃついてしまう予感。

 それと、アップされた例では 要素が F2:J2 の1か所だけですよね。
 この1つのデータに関して、C2,C3,C4 を計算して、それを B2,B3,B4 と比較するんですよね?

 それとも、F2:J2、F3:J3、・・・・F100000:J100000 といったように 膨大な行数があって、それぞれの行に対する工程1,2,3 を求めるのでしょうか?

 また、型番は、どのセルに入力しているのですか?

 あと、計算すると、どうしても端数に差異がでてくると思います。
 比較して、どれぐらいの精度で判定するのですか?

 電卓で計算してみたんですが たとえば アップされた例で 工程1 は 表示値 401 に対して
 計算すると 400.6ぐらいになりませんか?

(β) 2016/06/04(土) 22:32


 syさんβさんありがとうございます。
 <後数十万件と言うのは型番と言う事ですが、実際に外部から送られてくる検証しなければいけない
 データの 件数はどれくらいでしょうか?

 検証数は決められてはいませんが、沢山やればやるほどその精度は保証されます。
 それでも、労力にも限りがあり、全数検証する訳にはいきません。
 会社へ行かなと正しい数はわかりませんが、シリーズごとの規格の、最小と中と最大くらいにしようかと
 考えています。このやり方でも1万超えだと思います。正確に答えられなくてすみません。

 <要素が F2:J2 の1か所だけですよね。
 この1つのデータに関して、C2,C3,C4 を計算して、それを B2,B3,B4 と比較するんですよね?

 1つの型番につき、C2,C3,C4 を計算して、それを B2,B3,B4 と比較です。

 <型番は、どのセルに入力しているのですか?

 型番の入力セルは違うシートにあり、カタログから貼り付けることにより、F2:J2 がかわります。
 B2,B3,B4 もカタログから手で貼り付けます。

 <差異がでてくると思います。
 比較して、どれぐらいの精度で判定するのですか?
 そうなんです。どうしようかと考えていました。
 判定は小数点第1位までで良いと思います。

(グランパ) 2016/06/05(日) 00:02


 小数第1位にしてしまうと、工程3が困りませんか?
 まぁ、すべての表示値を小数第1位で丸めるということなら検証数値もそうしたらいいとは思いますが。
 それでも、四捨五入?切り捨て?切り上げ? これは決めておかなければいけないと思いますが。

 以下は、いっさい、そのようなことをせず、計算結果をそのまま比較しています。

 コード、もっと、スッキリした頭脳の持ち主なら、もう少しスマートになるんだろうと思いますが
 頭の中がグチャグチャのβですので、ベタベタの力技になりました。

 (しつこいようですが、数式+条件付書式がいいと思いますよ)

 Sub Sample()
    Dim sv As Variant
    Dim x As Variant
    Dim y As Variant
    Dim w As Variant
    Dim i As Long, j As Long
    Dim 検証1 As Range, 検証2 As Range, 検証3 As Range
    Dim 判定1 As Boolean, 判定2 As Boolean, 判定3 As Boolean
    Dim 直径 As Double, 全長 As Double, 柄径 As Double, 刃長 As Double, 刃数 As Double
    Dim a As Double, b As Double, c As Double, d As Double, e As Double

    '準備
    With Sheets("検証")
        直径 = .Range("F2").Value
        全長 = .Range("G2").Value
        柄径 = .Range("H2").Value
        刃長 = .Range("I2").Value
        刃数 = .Range("J2").Value
        With .Range("C2:C4")
            .ClearContents
            .Interior.Color = vbRed
        End With
        Set 検証1 = .Range("C2")
        Set 検証2 = .Range("C3")
        Set 検証3 = .Range("C4")
    End With

    '工程1
    With Sheets("工程1")
        With .Range("A1").CurrentRegion
            sv = .Range("A1").CurrentRegion.Value
            With .Offset(, 2).Resize(, .Columns.Count - 2)
                .Rows(1).Replace What:="以下", Replacement:="", LookAt:=xlPart
                .Sort key1:=.Rows(1), Order1:=xlDescending, Orientation:=xlLeftToRight, Header:=xlNo
            End With

            y = Application.Match(直径, .Columns("A").Resize(.Rows.Count - 1).Offset(1), 1)
            If IsNumeric(y) Then
                y = y + 1
                If 直径 <= .Cells(y, "B").Value Then '念のため
                    x = Application.Match(全長, .Rows(1).Resize(, .Columns.Count - 2).Offset(, 2), -1)
                    If IsNumeric(x) Then
                        x = x + 2
                        検証1.Value = 50000 / .Cells(y, x).Value / 0.8
                        If 検証1.Value = 検証1.Offset(, -1).Value Then
                            検証1.Interior.ColorIndex = xlNone
                            判定1 = True
                        End If
                    End If
                End If
            End If
            .Value = sv
        End With
    End With

    '工程2
    With Sheets("工程2")
        With .Range("A1").CurrentRegion
            y = Application.Match(直径, .Columns("A").Resize(.Rows.Count - 1).Offset(1), 1)
            If IsNumeric(y) Then
                y = y + 1
                If 直径 <= .Cells(y, "B").Value Then    '念のため
                    d = .Cells(y, "C").Value
                    a = .Cells(y, "D").Value
                    b = .Cells(y, "E").Value
                    c = .Cells(y, "F").Value
                    検証2.Value = d + a * 直径 + b * 刃長 + c * 刃数
                    If 検証2.Value = 検証2.Offset(, -1).Value Then
                        検証2.Interior.ColorIndex = xlNone
                        判定2 = True
                    End If
                End If
            End If
        End With
    End With

    '工程3
    With Sheets("工程3")
        e = .Range("A2").Value
        a = .Range("B2").Value
        b = .Range("C2").Value
        c = .Range("D2").Value
        d = .Range("E2").Value
        検証3 = e + a * 直径 + b * 刃長 + c * 柄径 + d * 全長
        If 検証3.Value = 検証3.Offset(, -1).Value Then
            検証3.Interior.ColorIndex = xlNone
            判定3 = True
        End If
    End With

    '総合判定
    Sheets("検証").Activate

    ReDim w(1 To 3)
    w(1) = IIf(判定1, vbTab, "工程1")
    w(2) = IIf(判定2, vbTab, "工程2")
    w(3) = IIf(判定3, vbTab, "工程3")
    w = Filter(w, vbTab, False)

    If UBound(w) < 0 Then
        MsgBox "すべて差異はありませんでした"
    Else
        MsgBox "赤く塗られた以下の項目に差異があります" & vbLf & Join(w, vbLf)
    End If

 End Sub

(β) 2016/06/05(日) 00:30


 βさん、おはようございます。
 たいへん勉強になります。ありがとうございます。

 βさんの言われていたように、端数が問題になります。
 表示値と検証値の端数差異、工程ごとに変えることは出来るでしょうか?

 工程1は小数点第一位を四捨五入して整数に。
 工程2と3は小数点第三位を四捨五入で第二位までの比較はできるでしょうか?
(グランパ) 2016/06/05(日) 09:23

 ふつうに、シート関数の ROUND を使えばいかがですか?

 検証1.Value = 50000 / .Cells(y, x).Value / 0.8
 検証2.Value = d + a * 直径 + b * 刃長 + c * 刃数
 検証3 = e + a * 直径 + b * 刃長 + c * 柄径 + d * 全長

 をそれぞれ以下に。(検証3の左辺、.Value なくても結果オーライですが、きちんと付けておきました)

 検証1.Value = WorksheetFunction.Round(50000 / .Cells(y, x).Value / 0.8, 0)
 検証2.Value = WorksheetFunction.Round(d + a * 直径 + b * 刃長 + c * 刃数, 2)
 検証3.Value = WorksheetFunction.Round(e + a * 直径 + b * 刃長 + c * 柄径 + d * 全長, 2)

(β) 2016/06/05(日) 09:54


 検証対象データの件数が万を超えるなら、関数でするのは大変ですね。
 検証シートのレイアウトをリスト形式にして、一括で処理するのはどうでしょうか?

 以下は一案です。

 検証シートのレイアウト
     |[A]   |[B] |[C]   |[D]  |[E]  |[F]  |[G]  |[H]  |[I]   |[J]|[K] |[L] |[M] |[N] |[O] |[P] 
 [1]|       |    |表示値|     |     |検証 |     |     |      |   |型番|    |    |    |    |    
 [2]|検証No.|型番|工程1 |工程2|工程3|工程1|工程2|工程3|判定  |   |型番|直径|全長|柄径|刃長|刃数
 [3]|      1|   1|   401| 12.5| 1.48|  401| 12.5| 1.48|      |   |   1|   8| 120|   8|  20|   2
 [4]|      2|   2|   801| 11.6|  4.4|  801| 11.6| 4.45|不一致|   |   2| 6.5| 300|   8|  20|   2
 [5]|      3|   3|   802| 12.5| 2.84|  801| 12.5| 2.84|不一致|   |   3|   8| 200|   8|  20|   2

 検証シートのB列に型番、C〜E列に外部からの工程の表示値を転記します。
 csvとかでデータとしてあるなら、マクロで読込む事も可能です。
 無ければ手入力しかありません。

 工程1シート
    |[A] |[B]|[C]|[D]   |[E]    |[F]    
 [1]|min |max|  0|70以下|120以下|300以下
 [2]| 0.1|0.5|   |   216|    144|     72
 [3]|0.51|  2|   |   648|    432|    216
 [4]|2.01|  3|   |   504|    336|    168
 [5]|3.01|  4|   |   504|    336|    168
 [6]|4.01|  6|   |   324|    216|    108
 [7]|6.01|  8|   |   234|    156|     78

 C列を挿入して、C1セルに0を入力しておきます。
 D1〜F1セルは、実際の値は70.1、120.1、300.1にしておいて、書式で「0"以下"」とします。

 工程2シート、工程3シートは変更の必要はありません。

 VLOOKUPで型番から直径などを取得してるとの事なので、型番シート(実際のシート名に読みかえて下さい)
 のレイアウトを以下のようにして、
     |[A] |[B] |[C] |[D] |[E] |[F] 
 [1] |型番|直径|全長|柄径|刃長|刃数
 [2] |   1|   8| 120|   8|  20|   2
 [3] |   2| 6.5| 300|   8|  20|   2
 [4] |   3|   8| 200|   8|  20|   2
 [5] |   4|   7| 150|   8|  20|   2
 [6] |   5|   6|  60|   8|  20|   2
 [7] |   6|   5|  50|   8|  20|   2
 [8] |   7|   4| 100|   8|  20|   2
 [9] |   8| 5.5| 120|   8|  20|   2
 [10]|   9|   1| 130|   8|  20|   2

 型番は文字でも良いですが、必ず型番で昇順に並べ替えておきます。

 上記のようなシート構成、レイアウトにして、下記コードを実行します。
 これで私の環境で、検証データ数が1万件で2秒くらい、10万件で10秒くらい、60万件で1分弱でした。
 工程1シートと工程2シートのレイアウトを変えれば、さらに半分以下の時間で検証する事も可能です。
 (ただ工程1、工程2のレイアウト変更は、初めの一回だけとは言え、めんどくさいです。)

 Sub test()
    Dim c1, c2, s1, s2, s4
    Dim sh0 As Worksheet, sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
    Dim i As Long, j As Integer
    Dim y As Long, x As Integer
    Dim e As Double, a As Double, b As Double, c As Double, d As Double
    Dim t As Double

    t = Timer

    'シート格納
    Set sh0 = Sheets("検証")
    Set sh1 = Sheets("工程1")
    Set sh2 = Sheets("工程2")
    Set sh3 = Sheets("工程3")
    Set sh4 = Sheets("型番")

    'シート初期化
    sh0.Range("A3:A" & Rows.Count).ClearContents
    sh0.Range("F3:I" & Rows.Count).ClearContents
    sh0.Range("K3:P" & Rows.Count).ClearContents

    'データ格納
    c1 = sh0.Range("A2").CurrentRegion.Value
    s1 = sh1.Range("A1").CurrentRegion.Value
    s2 = sh2.Range("A1").CurrentRegion.Value
    e = sh3.Range("A2").Value
    a = sh3.Range("B2").Value
    b = sh3.Range("C2").Value
    c = sh3.Range("D2").Value
    d = sh3.Range("E2").Value
    s4 = sh4.Range("A1").CurrentRegion.Value

    '型番情報
    sh0.Range("K3:K" & UBound(c1, 1)).Value = sh0.Range("B3:B" & UBound(c1, 1)).Value
    c2 = sh0.Range("K2").CurrentRegion.Value
    For i = 3 To UBound(c2, 1)
        y = WorksheetFunction.Match(c2(i, 1), sh4.Range("A:A"))
        c2(i, 2) = s4(y, 2)
        c2(i, 3) = s4(y, 3)
        c2(i, 4) = s4(y, 4)
        c2(i, 5) = s4(y, 5)
        c2(i, 6) = s4(y, 6)
    Next i
    sh0.Range("K2").CurrentRegion.Value = c2

    '検証値
    For i = 3 To UBound(c1, 1)
        '検証No.表記
        c1(i, 1) = i - 2
        '工程1
        y = WorksheetFunction.Match(c2(i, 2), sh1.Range("A:A"))
        x = WorksheetFunction.Match(c2(i, 3), sh1.Range("1:1")) + 1
        c1(i, 6) = WorksheetFunction.Round(50000 / s1(y, x) / 0.8, 0)
        If c1(i, 3) <> c1(i, 6) Then c1(i, 9) = "不一致"
        '工程2
        y = WorksheetFunction.Match(c2(i, 2), sh2.Range("A:A"))
        c1(i, 7) = WorksheetFunction.Round(s2(y, 3) + s2(y, 4) * c2(i, 2) + s2(y, 5) * c2(i, 5) + s2(y, 6) * c2(i, 6), 2)
        If c1(i, 4) <> c1(i, 7) Then c1(i, 9) = "不一致"
        '工程3
        c1(i, 8) = WorksheetFunction.Round(e + a * c2(i, 2) + b * c2(i, 5) + c * c2(i, 4) + d * c2(i, 3), 2)
        If c1(i, 5) <> c1(i, 8) Then c1(i, 9) = "不一致"
    Next i
    sh0.Range("A2").CurrentRegion.Value = c1

    '条件付き書式の設定
    sh0.Cells.FormatConditions.Delete
    With sh0.Columns("A:I")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$I1=""不一致"""
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.Color = 14083324
        .FormatConditions(1).StopIfTrue = False
    End With
    With sh0.Range("F:F,C:C")
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=AND(ROW()>0,$C1*$F1>0,$C1<>$F1)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Font.Color = -16776961
        .FormatConditions(1).StopIfTrue = False
    End With
    With sh0.Range("G:G,D:D")
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=AND(ROW()>2,$D1*$G1>0,$D1<>$G1)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Font.Color = -16776961
        .FormatConditions(1).StopIfTrue = False
    End With
    With sh0.Range("H:H,E:E")
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=AND(ROW()>2,$E1*$H1>0,$E1<>$H1)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Font.Color = -16776961
        .FormatConditions(1).StopIfTrue = False
    End With
    With sh0.Columns("I:I")
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="=""不一致"""
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Font.Color = -16776961
        .FormatConditions(1).StopIfTrue = False
    End With

    Debug.Print Timer - t

 End Sub

(sy) 2016/06/05(日) 14:11


 To グランパさん

 syさんのコメント、

 >>検証対象データの件数が万を超えるなら、関数でするのは大変ですね。
 >>検証シートのレイアウトをリスト形式にして、一括で処理するのはどうでしょうか?

 同感です。で、これは、そちらの仕様による私がアップしたマクロ処理でも大変です。
 何万も検証するわけですから、なん万回も入力し(コピペ?)なん万回もマクロ実行しなければいけませんね。

 かならずなん万回も検証するということではなく、そのなかの、1つ、2つを検証してみようという業務なら
 そちらの仕様(したがってβのコード)でもよろしいのですが、つねに数万種類の型番をチェックするという業務であれば
 レイアウトそのものを syさんが提示されたリスト形式にして、えいやっと、一括処理したほうがいいと思います。

(β) 2016/06/05(日) 14:25


 syさん、驚きました。こんなやり方があるんですね。
 たいへん参考になりました。
 ありがとうございました。

 βさん、よきコードやアドバイスありがとうございました。
 良い勉強になりそうです。
(グランパ) 2016/06/05(日) 20:51

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.