書誌データの重複削除と、データベースからの書名検索

Sub 項目表示()
        With Worksheets("作業シート")
            .Range("E1") = "場所"
            .Range("F1") = "書誌コード"
            .Range("G1") = "書名"
            .Range("H1") = "本体価格"
            .Range("I1") = "冊数"
            .Range("J1") = "合計"
        End With
End Sub

Sub 書誌重複削除()
    Dim Krow As Long
    Dim i As Long, j As Long
    Dim Dic As Object
        Worksheets("作業シート").Select
        Range("F:F").NumberFormatLocal = "@"
        Set Dic = CreateObject("Scripting.Dictionary")
        Krow = Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To Krow
            Dic.Add Worksheets("作業シート").Cells(i, 1) _
                    .Value, ActiveSheet.Cells(i, 2).Value
            On Error Resume Next
        Next i
        For j = 0 To Dic.Count - 1
            myKeys = Dic.keys
            myItems = Dic.Items
            Range("F" & j + 2).Value = myKeys(j)
            Range("H" & j + 2).Value = myItems(j)
        Next j
        With Range("F:H")
            .EntireColumn.AutoFit
        End With
End Sub

Sub 冊数合計マッチ()
    Dim Mr As Long
    Dim m As Long
        Worksheets("作業シート").Select
        frow = Cells(Rows.Count, 6).End(xlUp).Row
        For m = 1 To frow
            On Error Resume Next
            Mr = WorksheetFunction.Match(Range("F" & m), _
                    Range("A:A"), 0)
            Range("I" & m).Value = Range("C" & Mr).Value
            Range("J" & m).Value = Range("H" & m).Value _
                    * Range("I" & m).Value
            If Range("F" & m) = "" Then
                Range("H" & m, "J" & m) = ""
            End If
        Next m
        With Range("I:I")
            .NumberFormatLocal = "0_"
            .EntireColumn.AutoFit
        End With
        With Range("J:J")
            .NumberFormatLocal = "\#,##0;\-#,##0"
            .EntireColumn.AutoFit
        End With
End Sub

Sub 書誌名挿入()
step_cont:
        Application.ScreenUpdating = False
    Dim RP As Integer
    Dim FileD As FileDialog
        Set FileD = Application.FileDialog(msoFileDialogOpen)
            With FileD
                .ButtonName = "開く"
                    With .Filters
                        .Clear
                        .Add "Excelブック", _
                                "*.xls; *.xlsx; *.xlsm", 1
                        .Add "テキストファイル", "*.csv", 2
                    End With
                 .InitialFileName = ThisWorkbook.Path & _
                        "\書誌データベース\"
                 .InitialView = msoFileDialogViewLargeIcons
                    If .Show = True Then
                        .Execute
                    Else
                        MsgBox "終了します。"
                        Exit Sub
                    End If
            End With
        Call Module2.書誌チェック
            With Range("F:J")
                .EntireColumn.AutoFit
            End With
        RP = MsgBox("続けてデータベースを開きますか？" _
                & vbCrLf & "続けるには「はい」を" & vbCrLf & _
                "終わるには「いいえ」を", vbYesNo + _
                vbQuestion, "確認")
            If RP = vbYes Then
                GoTo step_cont
            Else
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Application.ScreenUpdating = True
End Sub

Private Sub 書誌チェック()
        Application.ScreenUpdating = False
    Dim ASrow As Long
    Dim ASname As String
    Dim SRV, SC, SCt, SN As Variant
    Dim Sr, SCa, SNS As Long
    Dim SCS, SCG As String
    Dim s As Long
    Dim MsgR As Integer
    Dim BK As Workbook
        Set BK = ActiveWorkbook
    Dim BS As Worksheet
        Set BS = BK.Worksheets("Sheet1")
    Dim TB As Workbook
        Set TB = Workbooks("書誌在庫表.xlsm")
    Dim SS As Worksheet
        Set SS = TB.Worksheets("作業シート")
        TB.Activate
        SS.Select
        frow = Cells(Rows.Count, 6).End(xlUp).Row
        For s = 2 To frow
            SC = 0
            TB.Activate
            SS.Select
            SRV = Range("F" & s).Value
            If SRV = "" Then GoTo step_a
                SCS = CStr(SRV)
                    If Len(Trim(SCS)) = 6 Then
                        SC = CLng(Left(Trim(SCS), 4))
                        SCG = CLng(Right(Trim(SCS), 2)) & "月"
                    ElseIf Len(Trim(SCS)) = 7 Then
                        SC = CLng(Left(Trim(SCS), 5))
                        SCG = CLng(Right(Trim(SCS), 2)) & "月"
                    ElseIf Len(Trim(SCS)) = 13 Then
                        SCt = Right(Trim(SCS), 10)
                        SC = Val(SCt)
                        SCG = ""
                    Else
                        MsgR = MsgBox("コードの桁数が違います。" _
                        & vbCrLf & "全体処理を中止しますか？（はい）" _
                        & vbCrLf & "この処理をＪｕｍｐますか？（いいえ）", _
                        vbYesNo + vbExclamation)
                        If MsgR = vbYes Then
                            Exit Sub
                        Else
                        End If
                    End If
                BK.Activate
                BS.Select
                Sr = 0
                On Error Resume Next
                Sr = WorksheetFunction.Match(SC, Range("D:D"), 0)
                If Err.Number = 1004 Then
                    Err.Clear
                Else
                    SN = Range("I" & Sr)
                    TB.Activate
                    SS.Select
                    If SN <> "" Then
                        Range("G" & s) = SN & " " & SCG
                    End If
                End If
step_a:
        Next s
        With Range("G:G")
            .EntireColumn.AutoFit
        End With
        BK.Close False
        Application.ScreenUpdating = True
End Sub