[[20171214010154]]　『2つのシートから条件にあった内容を別シートに抽潤x（素人）　ページの最後に飛ぶ

『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 ＞

いっぱい配列にセットしていますが、比較に必要なのはコードと在庫だけですよね？他の代入処理時間は無駄です。あと、ループの中でいちいちシートをSelectするのも無駄。かなり変わってしまいますが、私なりに書き直してみた例なぞ。

 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

大きな勘違いをしていました。在庫変動分シートに書き出すのは、当日分の情報でしたね。前日分の情報を書き出してしまいました。
直しついでに、在庫の増減をI列に書き出してみました。

 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

コメント返信：

[ 一覧(最新更新順) ]

[[20171214010154]] 『2つのシートから条件にあった内容を別シートに抽潤x（素人） ページの最後に飛ぶ

[[20171214010154]]　『2つのシートから条件にあった内容を別シートに抽潤x（素人）　ページの最後に飛ぶ