| 
    
     |  | 万件単位のデータを扱うのであれば、 まず、ハードウェアから対処したらどうでしょう。
 
 メモリーに空きがあれば増設する。
 あるいはハードディスクの容量を増やす。(例えば250GBを1TBにする。)
 SATAをSATA IIにするとか…(自分のパソコンのフタをはずして見たら、両規格接続できるようになっていました。)
 
 その前に、取り敢えず、マクロには「Application.ScreenUpdating = False」
 (無論、処理終了前に必ずTrueを指定)を追加。
 
 それからIf文の一部はSelect Case文を使うほうがいいでしょう。
 掲示マクロのIf文は下のような意味になるだろうと考えてみましたが、
 果たして正しく動作するかどうか不明。御参考までに。
 
 If TARGET(r, 0) <> Cells(i, "A").Value Then
 GoTo 抜ける
 End If
 '
 myItem = Cells(i, 1).Value 'A列
 必要数 = Cells(i, 2).Value 'B列
 '
 'もし、空白でなかったら、
 If Cells(i, x).Value <> "" Then
 Select Case TARGET(r, 1)
 '
 ' 必要数が仕掛より少ない場合はピンク(引当)
 Case 0
 Select Case TARGET(r, 2)
 Case 0
 GoTo 抜ける
 Case Is > 必要数
 Cells(i, x).Interior.ColorIndex = 38
 TARGET(r, 2) = TARGET(r, 2) - 必要数
 Case Else ' 0 to 必要数
 Cells(i, x).Interior.ColorIndex = 6
 TARGET(r, 2) = 0
 End Select
 '
 ' 必要数が在庫より少ない場合は緑(引当)
 Case Is > 必要数
 Cells(i, x).Interior.ColorIndex = 4
 TARGET(r, 1) = TARGET(r, 1) - 必要数
 
 ' 必要数が在庫より多くて、在庫がゼロより多い場合は数不足の為、黄色
 Case Else ' 0 to 必要数
 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 '完成引当の終了
 End Select
 End If
 
 |  |