[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2つのシートから条件にあった内容を別シートに抽出』(素人)
日々更新される、在庫シートがあり、在庫数に変更があった分だけ別シートに写したいのですが、なにぶん素人なので以下の記述しかできないのですが
この処理では途方も無い時間がかかり4万行もあるデータを処理できないなので
よろしくお願いいたします
Sub 在庫チェック()
Application.ScreenUpdating = False
Dim code(40000) As String
Dim zaiko(40000) As String
Dim brand(40000) As String
Dim syouhin(40000) As String
Dim jyoudai(40000) As String
Dim tanka(40000) As String
Dim lot(40000) As String
Sheets("当日在庫表").Select
Y = 2: cnt = 0
Do Until Cells(Y, 1).Value = ""
cnt = cnt + 1
code(cnt) = Cells(Y, 1).Value
zaiko(cnt) = Cells(Y, 2).Value
brand(cnt) = Cells(Y, 3).Value
syouhin(cnt) = Cells(Y, 4).Value
jyoudai(cnt) = Cells(Y, 5).Value
tanka(cnt) = Cells(Y, 6).Value
lot(cnt) = Cells(Y, 7).Value
Y = Y + 1
Loop
'つき合せ
'在庫変動分
Sheets("前日在庫表").Select
Z = 2
For I = 1 To cnt
YY = 2
Do Until Cells(YY, 2).Value = ""
If code(I) = Cells(YY, 1).Value And zaiko(I) <> Cells(YY, 2) Then
Sheets("在庫変動分").Select
Cells(Z, 1).Value = code(I)
Cells(Z, 2).Value = zaiko(I)
Cells(Z, 3).Value = brand(I)
Cells(Z, 4).Value = syouhin(I)
Cells(Z, 5).Value = jyoudai(I)
Cells(Z, 6).Value = tanka(I)
Cells(Z, 7).Value = lot(I)
Cells(Z, 8).Value = I + 1
Z = Z + 1
Else
YY = YY + 1
Sheets("前日在庫表").Select
End If
Loop
Sheets("前日在庫表").Select
Next I
Sheets("在庫変動分").Select
Application.ScreenUpdating = True
End Sub
また、当日在庫表については商品自体が増えたり減ったりしますので、
その部分も在庫変動分のシートでわかればと思っております
< 使用 Excel:Excel2013、使用 OS:Windows7 >
Sub test() Dim DIC As Object Dim wkOut As Worksheet Dim i As Long Dim z As Long
Application.ScreenUpdating = False
Set DIC = CreateObject("Scripting.Dictionary") Set wkOut = Sheets("在庫変動分") With wkOut z = .Cells(.Rows.Count, "A").End(xlUp).Row If 1 < z Then .Range("A2:H" & z).ClearContents End If End With
z = 2
With Sheets("当日在庫表") For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If DIC.Exists(.Cells(i, "A").Value) = False Then DIC.Add .Cells(i, "A").Value, .Cells(i, "B").Value End If Next i End With
With Sheets("前日在庫表") For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If .Cells(i, "B").Value <> DIC(.Cells(i, "A").Value) Then .Range(.Cells(i, "A"), .Cells(i, "G")).Copy wkOut.Cells(z, "A") wkOut.Cells(z, "H").Value = i z = z + 1 End If Next i End With
wkOut.Select Application.ScreenUpdating = True End Sub (???) 2017/12/14(木) 09:55
Sub test() Dim DIC As Object Dim wkOut As Worksheet Dim i As Long Dim z As Long
Application.ScreenUpdating = False
Set DIC = CreateObject("Scripting.Dictionary") Set wkOut = Sheets("在庫変動分") With wkOut z = .Cells(.Rows.Count, "A").End(xlUp).Row If 1 < z Then .Range("A2:I" & z).ClearContents End If End With
z = 2
With Sheets("前日在庫表") For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If DIC.Exists(.Cells(i, "A").Value) = False Then DIC.Add .Cells(i, "A").Value, .Cells(i, "B").Value End If Next i End With
With Sheets("当日在庫表") For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If DIC.Exists(.Cells(i, "A").Value) = True Then If .Cells(i, "B").Value <> DIC(.Cells(i, "A").Value) Then .Range(.Cells(i, "A"), .Cells(i, "G")).Copy wkOut.Cells(z, "A") wkOut.Cells(z, "H").Value = i If .Cells(i, "B").Value < DIC(.Cells(i, "A").Value) Then wkOut.Cells(z, "I").Value = "Down" Else wkOut.Cells(z, "I").Value = "Up" End If z = z + 1 End If Else .Range(.Cells(i, "A"), .Cells(i, "G")).Copy wkOut.Cells(z, "A") wkOut.Cells(z, "H").Value = i wkOut.Cells(z, "I").Value = "New" z = z + 1 End If Next i End With
wkOut.Select Application.ScreenUpdating = True End Sub (???) 2017/12/14(木) 10:40
ご返信遅れまして申し訳ございません
非常に助かりました。
何分、よくわからないままに組んでみたので、無茶苦茶でしたので
本当に助かりました。
これから1行づつ解析しながら紐解いていきたいと思います。
本当にありがとうございます。
(素人) 2017/12/16(土) 11:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.