[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件が増えて旨くいきません2』（あちゃこ） Sheet1のA列の営業所Wの不良数(B列受入-C列合格)をSheet2に転記し、 不良率(B列受入-C列合格)/B列受入)をSheet3に転記したいと思っています。 なお 下記に示す、Sub test3()は最初に学んだもので、馴染みやすく、ﾚｲｱｳﾄ等 が違いますが、これを活用したいと思っています。ご指導よろしくお願いします。
Sheet1 Sheet2
A B C D E A B C D E F
1 営業所 受入 合格 型式 名前 森田 石田 山本 坂本 鈴木
2 W 20 19 20-1 森田 20-1
3 S 30 28 20-3 石田 20-2
4 W 20 20 20-5 山本 20-3
5 S 10 9 20-3 石田 20-4
6 W 40 37 20-2 坂本 20-5
7 W 30 29 20-2 坂本
8 E 40 46 20-4 鈴木
Sheet3
A B C D E F
1 森田 石田 山本 坂本 鈴木
2 20-1
3 20-2
4 20-3
5 20-4
6 20-5
Sub test3()
Dim tbl As Variant
Dim Dat() As Double
Dim buf As String
Dim i As Long
Dim j As Long
Dim myTime As Double
myTime = Timer
tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) = "W" Then
buf = tbl(i, 3) & vbTab & tbl(i, 4)
.Item(buf) = .Item(buf) + tbl(i, 2)
End If
Next i
With Worksheets("Sheet2").Range("A1").CurrentRegion
tbl = .Value
ReDim Dat(1 To .Rows.Count - 1, 1 To .Columns.Count - 1)
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
Dat(i - 1, j - 1) = .Item(buf)
Next j
Next i
End With
Worksheets("Sheet2").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat
MsgBox Format(Timer - myTime, "#,##0.00") & "秒かかりました。"
End Sub
とりあえず
Sheet2とSheet3の列見出し、行見出しが同じということなら、ループを１つにして処理することもできるけど とにかく、地道に、それぞれ別処理で。
Sub test4()
Dim tbl As Variant
Dim Dat() As Double
Dim buf As String
Dim i As Long
Dim j As Long
Dim wk As Variant
Dim myTime As Double
myTime = Timer
tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) = "W" Then
buf = tbl(i, 4) & vbTab & tbl(i, 5)
If Not .exists(buf) Then .Item(buf) = Array(0, 0)
wk = .Item(buf)
wk(0) = wk(0) + tbl(i, 2)
wk(1) = wk(1) + tbl(i, 3)
.Item(buf) = wk
End If
Next i
With Worksheets("Sheet2").Range("A1").CurrentRegion
tbl = .Value
ReDim Dat(1 To .Rows.Count - 1, 1 To .Columns.Count - 1)
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
If .exists(buf) Then Dat(i - 1, j - 1) = .Item(buf)(0) - .Item(buf)(1)
Next j
Next i
Worksheets("Sheet2").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat
With Worksheets("Sheet3").Range("A1").CurrentRegion
tbl = .Value
ReDim Dat(1 To .Rows.Count - 1, 1 To .Columns.Count - 1)
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
If .exists(buf) Then
If .Item(buf)(0) <> 0 Then Dat(i - 1, j - 1) = (.Item(buf)(0) - .Item(buf)(1)) / .Item(buf)(0)
End If
Next j
Next i
End With
Worksheets("Sheet3").Range("B2").Resize(UBound(Dat, 1), UBound(Dat, 2)).Value = Dat
MsgBox Format(Timer - myTime, "#,##0.00") & "秒かかりました。"
End Sub
(ぶらっと)
これまでの処理では、転記先のマトリックスで転記元に存在しないセルは空白だったけど ↑でアップしたものは必ず計算される結果、ゼロが表示される。 これが目障りなら以下で。
あわせて、これまでのコードで、配列Datを転記用配列としているけど、実は、tbl配列が 転記用配列として「必要充分」なものだということは気づいている？ 以下では、そこもtbl一本にしている。
Sub test5()
Dim tbl As Variant
Dim buf As String
Dim i As Long
Dim j As Long
Dim wk As Variant
Dim num As Variant
Dim myTime As Double
myTime = Timer
tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) = "W" Then
buf = tbl(i, 4) & vbTab & tbl(i, 5)
If Not .exists(buf) Then .Item(buf) = Array(0, 0)
wk = .Item(buf)
wk(0) = wk(0) + tbl(i, 2)
wk(1) = wk(1) + tbl(i, 3)
.Item(buf) = wk
End If
Next i
With Worksheets("Sheet2").Range("A1").CurrentRegion
tbl = .Value
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
If .exists(buf) Then
num = .Item(buf)(0) - .Item(buf)(1)
If num <> 0 Then tbl(i, j) = num
End If
Next j
Next i
Worksheets("Sheet2").Range("A1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl
With Worksheets("Sheet3").Range("A1").CurrentRegion
tbl = .Value
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
If .exists(buf) Then
num = CDec((.Item(buf)(0) - .Item(buf)(1)) / .Item(buf)(0))
If .Item(buf)(0) <> 0 And num <> 0 Then tbl(i, j) = num
End If
Next j
Next i
End With
Worksheets("Sheet3").Range("A1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl
MsgBox Format(Timer - myTime, "#,##0.00") & "秒かかりました。"
End Sub
(ぶらっと)
もし、Sheet2、Sheet3の構成が同じということであれば、その処理を一本化できる。 Test5ベースでSheet2,3用処理を一本化したものをTest6として。
Sub test6()
Dim tbl As Variant 'Sheet2用
Dim tbl3 As Variant 'Sheet3用
Dim buf As String
Dim i As Long
Dim j As Long
Dim wk As Variant
Dim num As Variant
Dim myTime As Double
myTime = Timer
tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tbl, 1)
If tbl(i, 1) = "W" Then
buf = tbl(i, 4) & vbTab & tbl(i, 5)
If Not .exists(buf) Then .Item(buf) = Array(0, 0)
wk = .Item(buf)
wk(0) = wk(0) + tbl(i, 2)
wk(1) = wk(1) + tbl(i, 3)
.Item(buf) = wk
End If
Next i
With Worksheets("Sheet2").Range("A1").CurrentRegion
tbl = .Value
tbl3 = tbl
End With
For i = 2 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
buf = tbl(i, 1) & vbTab & tbl(1, j)
If .exists(buf) Then
num = .Item(buf)(0) - .Item(buf)(1)
If num <> 0 Then tbl(i, j) = num
num = CDec((.Item(buf)(0) - .Item(buf)(1)) / .Item(buf)(0))
If .Item(buf)(0) <> 0 And num <> 0 Then tbl3(i, j) = num
End If
Next j
Next i
End With
Worksheets("Sheet2").Range("A1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl
Worksheets("Sheet3").Range("A1").Resize(UBound(tbl3, 1), UBound(tbl3, 2)).Value = tbl3
MsgBox Format(Timer - myTime, "#,##0.00") & "秒かかりました。"
End Sub
昨晩、就寝前にのぞいたら、Dictionaryの使い方の質問がアップされてたけど、消したのかな？ 自己解決ということかもしれないし、課題を整理中なのかもしれないので、もし、あらためて 質問がアップされたらお手伝いするね。
ところで、上で偉そうに（？）
>tbl配列が転記用配列として「必要充分」なものだということは気づいている？
なんて書いたけど、よくよく考えると、今までのものは、配列内の要素に対して全てDictionaryから 転記してたわけだよね。今回アップしているのは、Dictionaryに存在するものだけの転記になっている。 ということは、転記しないtblの要素は、最初の値、つまりシートから取り込んだときの値ということで もし、処理時点で、そこに値があれば、それがそのまま残ってしまう（本来は空白になるべき）
Test5,Test6 の tbl = .Value の前に、以下の１行を追加しておいて。
.Cells.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).ClearContents
(ぶらっと)
ぶらっとさん、ありがとうございます。 昨夜、質問してぶらっとさんの回答を期待して開いてみると無くなっていました。 ガックリです。 何方かの誤操作だと信じています。
If Not .exists(buf) Then .Item(buf) = Array(0, 0)
wk = .Item(buf)
wk(0) = wk(0) + tbl(i, 2)
wk(1) = wk(1) + tbl(i, 3)
.Item(buf) = wk
End If
目新しいものがたくさん出てきました。上記の部分解説いただけませんか？
たくさんのお言葉頂いていますが、まだ理解できません。少し時間を頂いて
学習したいと思っています。
（あちゃこ）
ちょっと一度にたくさん投げかけちゃったね。１つずつ、ゆっくりのほうがよかったと反省。 質問のとろころも、従来の処理構文を、一足飛びというか、階段を二段あがったものにしていた。
従来は、処理の要素が１つだったけど、今回は受入と合格の２つ。 Sheet2を作るだけなら、従来通り、不良品の数を計算したものを１つDictionaryにいれておけばよかったけど不良品率があるので どうしても、後半の処理に、受入合計と合格合計を渡してやらなきゃいけない。
ここで、まず、第一歩としてとるべき処理構造は、それぞれの要素を１つだけ格納したDictionaryを、２つ用意して 後半の処理では、その２つのDictionaryから、それぞれの値を取得して計算させるべきだったね。
ともあれ、書いてしまった（？）ので。 Dictionaryのデータとしては、従来のような単一の値の他、どのようなものでも格納できる。 で、今回は、受入合計と合格合計の２つの要素を持つ｢0から始まる一次元配列｣をいれている。 で、単一の要素であれば、Dictionaryにまだ存在しないキーを与えて .Item(キー)+10 といった計算をしても、0+10 と処理してくれる。だけど、今回は 配列(0) + 10、 配列(1) + 8 といった計算。 なにもない空っぽの場合、空白値(0) + 10 なんて実行するとエラーになる。（空白値は配列ではないので）
なので、まず そのDictionary.Exist(キー） というメソッドで、そのキーがあるかどうかを判定。 もし存在しなければ、そこに 0 を２つ持った一次元配列を格納して、そのデータの初期化を行っている。 .Item(buf) = Array(0, 0) が、その部分。Array関数は、指定した引数が配列の形で生成される。(ただし、LBoundは1ではなく0)
で次に、初期化されてしまえば .Item(buf) そのものが配列なので、 .Item(buf)(0) = .Item(buf)(0) + 10 とか .Item(buf)(1) = .Item(buf)(1) + 8 というように書けそうだよね。 でも、これがダメ。（今のところＭＳの仕様書でだめと書いてあるところを読んだことはないけど経験上わかっている）
Dictionaryのデータが配列で、その要素を変更する場合は、いったん wk = .Item(buf) として 配列を、自分の変数に取り出し wk(0) = wk(0) + tbl(i, 2) といった形で、自分の変数としての配列内で処理した後、 .Item(buf) = wk として、Dictionaryに 戻してやる必要がある。
この部分はわかりにくいかなぁ。時間があるときに以下を実行し、実行結果を把握した後、もう一度以下を眺めると なんとなく、つかめるかな？
Sub Test()
Dim dic As Object
Dim wk As Variant
Set dic = CreateObject("Scripting.Dictionary")
dic("A") = 20
MsgBox "加算前は" & dic("A")
dic("A") = dic("A") + 5
MsgBox "加算後は" & dic("A")
dic("B") = Array(10, 20)
MsgBox "加算前は" & dic("B")(1)
dic("B")(1) = dic("B")(1) + 5
MsgBox "加算後は" & dic("B")(1) & " あれ？"
dic("C") = Array(10, 20)
MsgBox "加算前は" & dic("C")(1)
wk = dic("C")
wk(1) = wk(1) + 5
dic("C") = wk
MsgBox "加算後は" & dic("C")(1) & " 今度はＯＫだった"
End Sub (ぶらっと)
ぶらっとさん、ありがとうございます。 理解力が乏しい故、進みが遅いことお許しください。お正月休みにはじっくり 腰を据えて出来るので楽しみです。 繰り返し走らせ、先生の解説を見ながら理解しようとしています。処理要素が 二つになると、こんなに複雑なことになるんですね。引き続き学習して身に つけたいと思います。 いつも丁寧な説明、感謝しています。 出来の悪いあちゃこ、見放さないで以後もよろしくお願いいたします。
（あちゃこ）
ぶらっとさん、困りました。HELPしてください。 ﾃﾞｰﾀが矛盾しているのに気がつきました。早合点してしまい申し訳ありません。 F列の不良数が増えて1行目から8行目まで0になっており、9行目以降に不良数 が入っています。かつ、BC列は9行目以降に0が入っています。 Sheet2に不良数、Sheet3に不良率を入れたいのですが、仕切り直ししていただけ ませんでしょうか。よろしくおねがいします。
Sheet1 Sheet2
A B C D E F A B C D E F
1 営業所 受入 合格 型式 名前 不良数 森田 石田 山本 坂本 鈴木
2 W 20 19 20-1 森田 0 20-1
3 W 30 28 20-3 石田 0 20-2
4 W 20 20 20-5 山本 0 20-3
5 S 10 9 20-3 石田 0 20-4
6 W 40 37 20-2 坂本 0 20-5
7 W 30 29 20-2 坂本 0
8 E 40 36 20-4 鈴木 0
9 W 0 0 20-1 森田 1
10 W 0 0 20-3 石田 2
11 S 0 0 20-3 石田 1
12 W 0 0 20-2 坂本 3
13 W 0 0 20-2 坂本 1
14 E 0 0 20-4 鈴木 4
Sheet3
A B C D E F
森田 石田 山本 坂本 鈴木
20-1
20-2
20-3
20-4
20-5
（あちゃこ）
ん？ 提示のレイアウトだと、うまくいかない？ いま、とりあえず、Test4を動かしたけど問題ないよ？
データとしては W 20 19 20-1 森田 1 これが 離れた行に W 20 19 20-1 森田 0 W 0 0 20-1 森田 1 このようになっているだけだよね？
追記）あっ、もしかして、不良品の数は 20 - 19 ではなく 下の方の 1 を採用したいということ？
(ぶらっと)
ぶらっとさん、ありがとうございます。 Test4でマクロは停止せずに動きますが、Sheet2、Sheet3が0になってしまします。 ﾚｲｱｳﾄをしっかり確認しながら、やっているのですが・・・ 0になるのは、どんなことが考えられますか？
ぶらっとさんが書かれているようにF列を不良数とし、不良率=F列(不良数)/B列 (受入)としたいのですが、お手数かけますが教えてください。
（あちゃこ）
今、さきほどとは違う環境で、新たにアップされたレイアウトで、アップ済みのTest4を実行したけど さきほどと同様、Sheet2,Sheet3 ともに、20-1の森田、20-2の坂本、20-3の石田で0以外が表示される。
>0になるのは、どんなことが考えられますか？
う〜ん・・・実際のシートを見ていないのでなんともいえないけど、Sheet1とSheet2,Sheeet3の マッチングキーが、実は違っているとか？ 特に型式。 20-1 といった形は「くせもの」だよね。 何にもしないでそのままセルに入力すると、１月20日 なんてことに。（日付型で、データとしては2011/1/20) 一方は、本当の文字列、一方は日付型を表示書式で、20-1 に「見せかけているだけ」とか。 または、Sheet1の事業所コード、マクロでは半角大文字の W を対象にしてるけど、実際のデータ上は、全角大文字のＷとか。
でも・・・そんなことはないんだろうなぁ。今、頭がぼぉっとして、思いつかない。 いずれにしても、不良品数をF列からとするコードは、あとでアップする。 だけど、もし、データの上のほうにある行が 20と19と0 、下のほうの行が 0と0と1 なら、結果は同じだから 今、0になっていれば、今度アップするコードでも 0 になるはず。
(ぶらっと)
Test4,5,6 ともに
wk(1) = wk(1) + tbl(i, 3) => wk(1) = wk(1) + tbl(i, 6)
.Item(buf)(0) - .Item(buf)(1) => .Item(buf)(1)
(.Item(buf)(0) - .Item(buf)(1)) => .Item(buf)(1)
でも、結果は同じだと思うけどなぁ。
(ぶらっと)
ぶらっとさん、お疲れのところ申し訳ありません。
注意点再度ﾁｪｯｸしてみます。 （あちゃこ）
ぶらっとさん、の言われていた20-1などﾁｪｯｸし、大丈夫でしたが 下記Sheet1、E列の名前が8行目まで「OK」が入っていました。 お疲れが取れてからで結構です。下記で再度お考え頂けないでしょうか？ 申し訳ないです。
Sheet1
Sheet2
A B C D E F A B C D E F
1 営業所 受入 合格 型式 名前 不良数 森田 石田 山本 坂本 鈴木
2 W 20 19 20-1 OK 0 20-1
3 W 30 28 20-3 OK 0 20-2
4 W 20 20 20-5 OK 0 20-3
5 S 10 9 20-3 OK 0 20-4
6 W 40 37 20-2 OK 0 20-5
7 W 30 29 20-2 OK 0
8 E 40 36 20-4 OK 0
9 W 0 0 20-1 森田 1
10 W 0 0 20-3 石田 2
11 S 0 0 20-3 石田 1
12 W 0 0 20-2 坂本 3
13 W 0 0 20-2 坂本 1
14 E 0 0 20-4 鈴木 4
Sheet3
A B C D E F
森田 石田 山本 坂本 鈴木
20-1
20-2
20-3
20-4
20-5
（あちゃこ）
お疲れは、とれたよ〜！
なぁるほど・・だけど・・・？？
たとえば 2行目の OKさん。本当は森田さんなんだろうけど、この行が森田さんというのは、どうやって判断しようか？ 2行目からOKがある行は、その下にある名前付の行と、かならず、同じ順序でペア？
というか、不思議なシートレイアウトだねぇ。普通なら9行目以降はないんじゃないかな？ F列に数式があって、=IF(C2="","",B2-C2) とか、やるんじゃないの？ （または、=IF(C2="","検査中",B2-C2) とか）
実際の入力作業としては、検査終了時点で、上のほうに合格件数をいれて、名前をOK にして 下のほうに、受入も合格も0の行をわざわざ作って、名前と不良数をいれてるの？？
えっ、そうすると、検査前のデータは上のほうに名前があって、下のほうの行は存在しない？ そういうケースもあるのかな？
いずれにしても,OKさんが誰なのか、どう判定するのか、そちらの運用ルールがわからないのでロジックが組めないね。 判定ルールを教えて。 (あちゃこさんが、このシートを目で見た時に、どう判定するのかのルール）
(ぶらっと)
ぶらっとさんありがとうございます。 実際のﾃﾞｰﾀを見ていただいて個人教授をして欲しい気持ちですが、そうもいかず・・・ ﾃﾞｰﾀの謎、整理できないか考えてみます。 （あちゃこ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.