ASINチェックVBAマクロ

2023年3月7日2023年3月8日

当ページのリンクには広告が含まれています。

ASIN番号の重複をチェックするマクロを作成しました。

ASINチェックVBA

ASINデータ(csv形式)と更新されたASINデータ(csv形式)を読込重複をチェックします。

DATA初期の読込

マクロメニューの「ＤＡＴＡ初期」をクリックして初期データの読込をします。

クリックするとファイルマネージャが立ち上がるのでデータを選択します。

選択するとシートに自動的に読み込まれます。

DATA追加の読込

次に今回追加されたデータを読込ます。

DATA初期に追加して更新されます。

重複のチェック

マクロメニューから「チェック」をクリックすると先頭に行が追加され重複チェックを検索します。

検出されたＡＳＩＮデータには「重複」と表示されます。

削除はまた後のマクロでね。。。。。

ソースコード

CSVデータ初期読込

DATA初期

Sub DATA初期()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long

Worksheets("DATA01").Activate

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                            Title:="CSVファイルの選択")
If varFileName = False Then
    Exit Sub
End If

intFree = FreeFile
Open varFileName For Input As #intFree 

i = 0
Do Until EOF(intFree)
    Line Input #intFree, strRec 
    i = i + 1
    strSplit = Split(strRec, ",")
    For j = 0 To UBound(strSplit)
        Cells(i, j + 1) = strSplit(j)
    Next
Loop

Close #intFree
End Sub

DATA追加

Sub DATA追記()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long
Dim iEnd As Long

Worksheets("DATA01").Activate

iEnd = Cells(Rows.Count, 1).End(xlUp).Row

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                            Title:="CSVファイルの選択")
If varFileName = False Then
    Exit Sub
End If

intFree = FreeFile 
Open varFileName For Input As #intFree 

i = 0
Do Until EOF(intFree)
    Line Input #intFree, strRec 
    i = i + 1
    strSplit = Split(strRec, ",") 
    For j = 0 To UBound(strSplit)
        Cells(i + iEnd, j + 1) = strSplit(j)
    Next
Loop

Close #intFree
End Sub

よしぼん

基本的にDATA初期とな同じですが、最終行から追記するので
Cells(Rows.Count, 1).End(xlUp).Row を使って最終行を
抽出しています。

チェック

Sub Check()
Dim A
Set A = CreateObject("Scripting.Dictionary")

Dim Data
Dim iEnd As Long

Worksheets("DATA01").Activate
iEnd = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A").Insert

ReDim Data(1 To iEnd, 1 To 1)

For i = 1 To iEnd
    If A.exists(Cells(i, "B").Value) = False Then
        A.Add Cells(i, "B").Value, 1 

    Else
        Data(i, 1) = "重複" '配列に「重複」を入力
    End If
Next
Range("A1").Resize(UBound(Data, 1)) = Data

End Sub

よしぼん

検索を早くする為に
ディクショナリー登録機能を利用しています。

これでＡＳＩＮデータの重複チェックが自動でできますね。