| |
今、在庫と仕掛品の引当表を作っています。
現在のコードでは、とてもじゃないけど、莫大な時間を要してしまって、
使いものにならない状態です。
なんとか、処理が高速化するようにコードを変えたいのですが、
いまいち、良い方法が思いつきません
[シート1] 部品の在庫数と仕掛数の一覧です
部品名 在庫数 仕掛数
AAA 10 10
BBB 15 12
CCC 13 20
DDD 20 16
EEE 10 7
FFF 40 20
上記のようなデータが8000件ほどあります
[シート2]から10シートほどに渡って、総計で6万件のデータが下記のように
あります
列数は、100列程度あります
部品名 必要数 A車 B車 C車 D車 E車…以降、まだ続きます
AAA 2 ● ● ● ● ←セルを引当可能なら塗りつぶす
CCC 2 ● ● ●
AAA 2 ● ●
BBB 4 ● ●
AAA 3 ●
EEE 7 ● ●
・
・
・
行数は各シート毎でバラバラですが、多いシートで38000件あります
引当の順としては、A車のAAA、A車のCCC、A車のAAA、A車のBBB、A車のAAA、A車のEEE、B車のAAA…、といったように、列毎から順に見ていきます
これを、A車から、順に在庫と仕掛を引当していくのですが、
在庫引当可能なら、緑色に塗りつぶす
在庫が不足してる場合は、黄色に塗りつぶす
在庫が引当できなくて、仕掛引当可能ならピンクに塗りつぶす
今のコードはこんな感じです
Dim TARGET() As Variant
Dim MyItem As String
Dim 必要数 As Long
Dim 最終C As Long
Dim 最終R As Long
Dim st As Single
st = Timer()
Sheets("シート1").Activate
i = 0
ReDim TARGET(Range("A" & Rows.Count).End(xlUp).Row, 2)
For i = 0 To Range("A" & Rows.Count).End(xlUp).Row
If i > 3 Then
’在庫表のデータを全て配列に格納します
TARGET(i - 4, 0) = Range("A" & i).Value
TARGET(i - 4, 1) = Range("B" & i).Value
TARGET(i - 4, 2) = Range("C" & i).Value
End If
Next i
'*********************************
'全シートに在庫仕掛を引当する
'在庫＝緑、仕掛＝ピンク、不足＝黄色
'*********************************
最終C = Sheets(2).Cells(1, Columns.Count).End(xlToLeft).Column
For r = 0 To UBound(TARGET)
For x = 3 To 最終C
For y = 2 To Sheets.Count
Worksheets(y).Activate
最終R = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To 最終R
If TARGET(r, 0) = Cells(i, "A").Value Then
MyItem = Cells(i, 1).Value 'A列
必要数 = Cells(i, 2).Value 'B列
'もし、空白でなかったら、
If Cells(i, x).Value <> "" then
'必要数が在庫より少ない場合は緑（引当）
If 必要数 <= TARGET(r, 1) Then
Cells(i, x).Interior.ColorIndex = 4
TARGET(r, 1) = TARGET(r, 1) - 必要数
'必要数が在庫より多くて、在庫がｾﾞﾛより多い場合は数不足の為、黄色
ElseIf TARGET(r, 1) <= 必要数 And TARGET(r, 1) > 0 Then
Cells(i, x).Interior.ColorIndex = 6
TARGET(r, 1) = 必要数 - TARGET(r, 1)
TARGET(r, 2) = TARGET(r, 2) - TARGET(r, 1)
TARGET(r, 1) = 0 '完成引当の終了
'必要数が仕掛より少ない場合はﾋﾟﾝｸ（引当）
ElseIf TARGET(r, 1) = 0 Then
If 必要数 <= TARGET(r, 2) Then
Cells(i, x).Interior.ColorIndex = 38
TARGET(r, 2) = TARGET(r, 2) - 必要数
'必要数が仕掛より多く、仕掛がｾﾞﾛより多かったら数不足の為、黄色
ElseIf TARGET(r, 2) <= 必要数 And TARGET(r, 2) > 0 Then
Cells(i, x).Interior.ColorIndex = 6
TARGET(r, 2) = 0
'仕掛がｾﾞﾛだったらﾙｰﾌﾟ抜ける
ElseIf TARGET(r, 2) = 0 Then GoTo 抜ける
End If
End If
End If
'End If
Else
GoTo 抜ける
End If
Next i
Next y
Next x
抜ける:
Next r
End Sub
分かりにくいかもしれませんが、どうか良きアドバイスがありましたらお願いします
|
|
かな
- 10/5/14(金) 8:56 -
