メルカリ物販を自動化するツール（エクセルVBAマクロ）

FIRE実現のために、メルカリで副業を実践しているものの、手間がかかって思うように捗らないという方、多いのではないかと思います。

そこで、エクセルマクロ（VBA）でメルカリの物販作業を自動化・効率化するツールを作成しましたので、シェアします。

自動出品する機能や、amazonから市場価格を取得する機能など、色々な機能を実装しました。

参考になれば幸いです。

エクセルブックの紹介

エクセルにて、以下のような管理台帳シートを作って、当該シートを用いて、出品から取引完了までを管理します。

実際のマクロ入りブックは以下です。

本マクロブックのサポートやカスタマイズについては、条件によって、有償にて対応受付しております。

以下、クラウドワークスないしココナラのアカウントよりご依頼いただければ幸いです。

FIRE太郎さん(その他)に依頼・外注する | 簡単ネット発注なら【クラウドワークス】

日本最大級のクラウドソーシング「クラウドワークス」にご登録いただいているFIRE太郎さんのプロフィールです。その他のスキルを持つプロフェッショナルに1時間から仕事を気軽に発注！発注者は手数料無料。

crowdworks.jp

FIRE太郎さん(会社員)のプロフィール | ココナラ

Excelマクロ（VBA）による自動化ツールの作成が得意です。｜ブログ「FIRE（早期リタイア）研究所」運営中

coconala.com

メルカリ物販用　VBAマクロの紹介

マクロの初期設定

まず、初期設定が必要です。

まず、以下記事を参考に、Seleniumの設定をします。

Seleniumを導入し、VBAでchromeを自動操作する設定手順

2022/6/16、InternetExplorer（IE）のサポートが終了しましたが、従来、IEとVBAを使ってWEBスクレイピングされていた方の乗り換え先として、Seleniumを導入し、VBAでchromeを自動操作するための設定手順を紹介します。

hineke.jp

2022.03.04

共通パーツとして、以下をモジュールにセットします。

'出品一覧ページ
'もっと見るボタン
Public Const SellingList_MoreButton As String = "//*[text()='もっと見る']"

'売却済一覧ページ
'もっと見るボタン
Public Const sold_List_MoreButton As String = "//*[text()='もっと見る']"



'出品個別ページ
'タイトル
Public Const Selling_title As String = "mer-spacing-b-12"

                    
'商品説明
Public Const Selling_explanation As String = "/html/body/div[1]/div/div[2]/main/article/div[2]/section[2]/div[2]/div/pre"

'価格
Public Const Selling_price As String = "/html/body/div[1]/div/div[2]/main/article/div[2]/section[1]/section[1]/div/div/div/span[2]"



'出品編集ページ
'タイトル
Public Const Selling_Edit_title As String = "name"

'商品説明
Public Const Selling_Edit_explanation As String = "description"

'価格
Public Const Selling_Edit_price As String = "price"

'変更する
Public Const Selling_Edit_update As String = "//button[text()='変更する']"



'取引ページ(出品中)
'購入日時
Public Const Tran_Selling_date As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[5]/div[2]/span"

'サイズと発送場所選択
Public Const Tran_Selling_selection_size As String = "//*[text()='商品サイズと発送場所を選択する']"

'ネコポス
Public Const Tran_Selling_selection_nekopos As String = "//*[text()='ネコポス']"

'選択して次へ
Public Const Tran_Selling_selection_next As String = "//*[text()='選択して次へ']"

'ファミマ
Public Const Tran_Selling_famima As String = "//*[text()='ファミリーマート']"

'セブンイレブン
Public Const Tran_Selling_711 As String = "/html/body/div[1]/div/div[2]/main/div/form/div[1]/div/div[1]/div/div[1]"

'選択完了
Public Const Tran_Selling_selection_end As String = "//*[text()='選択して完了する']"

'配送品名
Public Const Tran_Selling_productname As String = "itemName"

'QR表示
Public Const Tran_Selling_barcode As String = "//*[text()='発送用バーコードを発行']"

'QR表示
Public Const Tran_Selling_QR As String = "//*[text()='発送用QRコードを発行']"


'取引メッセージ
Public Const Tran_Selling_message As String = "chat"

'取引メッセージ送信
Public Const Tran_Selling_send_message As String = "//*[text()='取引メッセージを送る']"


'取引ページ(出荷後)
'発送通知をする
Public Const Tran_Selling_shipping As String = "//*[text()='商品を発送したので、発送通知をする']"

'発送通知をする２
Public Const Tran_Selling_shipping_agreement As String = "//*[text()=' 発送しました']"

'評価メッセージ
Public Const Tran_Selling_evaluation_message As String = "message"

                                                         
'評価する
Public Const Tran_Selling_evaluation_send As String = "//*[text()='購入者を評価して取引完了する']"

'取引完了する
Public Const Tran_Selling_transaction_completed As String = "//*[text()='取引を完了する']"



'取引完了後
'購入日時
Public Const Tran_Selling_close_date As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[6]/div[2]/span"

'購入価格
Public Const Tran_Selling_close_price As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[1]/div[2]/span/span"

'手数料
Public Const Tran_Selling_close_commission As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[2]/div[2]/span/span"

'配送料
Public Const Tran_Selling_close_DeliveryCharge As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[3]/div[2]/span/span"

'販売利益
Public Const Tran_Selling_close_profit As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[4]/div[2]/span/span"

'送料
Public Const Tran_Selling_close_postage As String = "/html/body/div/div/div[2]/main/div/div[1]/div/div/div[3]/div[5]/div[2]/span"



'購入者
Public Const Tran_Selling_close_buyer As String = "/html/body/div[1]/div/div[2]/main/div/div[2]/div[4]/a"

出品から取引終了までの基本機能

メルカリ出品ID取得

マクロを実行する前に、まず、スマホ版のメルカリアプリを使って手動で出品します。

この際の出品は仮状態でよいです。成約されないような高額な売価でとりあえず出品します。

その後、本項のマクロを動かすと、上記した新規出品IDをすべて取得し、エクセルのシートにレコード行を追加します。

行追加の際には、該当出品IDの、タイトルや説明文も取得します。手動出品時に、メルカリによって自動提案されたテキスト情報があれば、当該テキストが取得できます。

なお、説明文の取得に際しては、私が使っている定型文を冒頭に付加します（「中古品なので、多少のキズはご承知おき下さい～」を、メルカリ自動提案の説明文の冒頭に付加した上で、エクセルに取得）。

Sub メルカリ出品ID取得(PROFILE_PATH As String, Text As String, Selling_title As String, Selling_explanation As String, Selling_price As String, SellingList_MoreButton As String)

    Dim myBy As New By

    Set oBook0 = ActiveWorkbook
    
    If oBook0.Sheets("リスト").FilterMode = True Then
    
        oBook0.Sheets("リスト").ShowAllData
    Else
        oBook0.Sheets("リスト").Rows(2).AutoFilter
    
    End If
    
    driver.AddArgument ("user-data-dir=" & PROFILE_PATH)
    
    driver.Start "chrome"
    Application.Wait Now + TimeSerial(0, 0, 3)
    
    driver.Window.Maximize
    
    n = 1
    
    For n = 1 To 5
    
        driver.Get "https://jp.mercari.com/mypage/listings"
        
        Do Until driver.IsElementPresent(myBy.XPath("/html/body/div/div/div[2]/main/div/div[2]/div/div/div/div/div[3]/div[2]/div[1]/div[" & n & "]"))
            
            Application.Wait Now + TimeSerial(0, 0, 1)
        
        Loop
        
        Application.Wait Now + TimeSerial(0, 0, 2)
        
        driver.ExecuteScript "window.scrollTo(0, 0);"
        
        Application.Wait Now + TimeSerial(0, 0, 1)
        
        driver.FindElementByXPath("/html/body/div/div/div[2]/main/div/div[2]/div/div/div/div/div[3]/div[2]/div[1]/div[" & n & "]").Click
        
        Do Until driver.IsElementPresent(myBy.Class(Selling_title))
            
            Application.Wait Now + TimeSerial(0, 0, 1)
        
        Loop


        If WorksheetFunction.CountIf(oBook0.Sheets("リスト").Columns(2), Mid(driver.Url, 29, 30)) < 1 Then
    
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row + 1, 1) = 1
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = Mid(driver.Url, 29, 30)
    
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row, 3) = "出品中"
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row, 4) = driver.FindElementByClass(Selling_title).Text 'タイトル
    
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row, 6) = Text & driver.FindElementByXPath(Selling_explanation).Text 'コメント
    
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row, 8) = driver.FindElementByXPath(Selling_price).Text '価格
            oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row, 21) = driver.FindElementByXPath(Selling_price).Text '価格
            
        Else
        
            Exit For
    
        End If

    Next n
    
    If n > 5 Then

        driver.Get "https://jp.mercari.com/mypage/listings"
    
        driver.ExecuteScript "window.scrollTo(0, 0);"

        Err.Number = 0
            
        
        On Error Resume Next
        
        Do Until Err.Number <> 0
        
            Application.Wait Now + TimeSerial(0, 0, 2)
          
            driver.FindElementByXPath(SellingList_MoreButton).Click
        
        
        Loop
        
        
        On Error GoTo 0
        
        driver.ExecuteScript "window.scrollTo(0, 0);"
        
        EndRow = oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row + 1
        
        Dim LinkURL As Variant 'As HTMLAnchorElement
         
        For Each LinkURL In driver.FindElementsByTag("a").Attribute("href")
            If InStr(LinkURL, "/item/m") <> 0 And WorksheetFunction.CountIf(oBook0.Sheets("リスト").Columns(2), Mid(LinkURL, 7, 30)) = 0 Then
                oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = Mid(LinkURL, 7, 30)
            End If
        Next LinkURL
        
        Endrow2 = oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row
        
        
        For i = EndRow To Endrow2
        
        
10:
            On Error GoTo ERR10
        
            driver.Get "https://jp.mercari.com/item/" & oBook0.Sheets("リスト").Cells(i, 2)
            
            oBook0.Sheets("リスト").Cells(i, 1) = 1
            oBook0.Sheets("リスト").Cells(i, 3) = "出品中"
            
            oBook0.Sheets("リスト").Cells(i, 4) = driver.FindElementByClass(Selling_title).Text 'タイトル
        
            oBook0.Sheets("リスト").Cells(i, 6) = Text & driver.FindElementByXPath(Selling_explanation).Text 'コメント
        
            oBook0.Sheets("リスト").Cells(i, 8) = driver.FindElementByXPath(Selling_price).Text '価格
            oBook0.Sheets("リスト").Cells(i, 21) = driver.FindElementByXPath(Selling_price).Text '価格
        
            
        
            On Error GoTo 0
        
        Next i
    End If
    
    Set driver = Nothing
    
    oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues
    oBook0.Sheets("リスト").Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row + 1, 1).Select

    Exit Sub

ERR10:
    Resume 10


End Sub

amazon価格情報更新

出品する商品がamazonで取り扱いのある商品であれば、手動でamazonの商品URLを取得し、該当の出品レコード行の該当列に当該URLを手入力します。

その後、本項のマクロを動かすことで、新品の価格と、マーケットプレイスの最安値を取得します。

check欄に1を入れていると、該当行のみ、取得します。

check欄に1 が一つも入っていないと、ステータスが出品中の行すべての最新データを取得します。

amazonはスクレイピングが禁止されているため、実行時にはログオフしておくほうがよいでしょう。

Sub メルカリ_amazon価格更新(PROFILE_PATH As String)

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

If WorksheetFunction.CountIf(oBook0.Sheets("リスト").Columns(1), "1") >= 1 Then

    driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

End If

driver.Start "chrome"
Application.Wait Now + TimeSerial(0, 0, 3)



For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If (WorksheetFunction.CountIf(oBook0.Sheets("リスト").Columns(1), "1") >= 1 And oBook0.Sheets("リスト").Cells(i, 1) = "1") Or WorksheetFunction.CountIf(oBook0.Sheets("リスト").Columns(1), "1") < 1 And (oBook0.Sheets("リスト").Cells(i, 3) = "出品中" Or oBook0.Sheets("リスト").Cells(i, 3) = "") And oBook0.Sheets("リスト").Cells(i, 10) <> "" Then

        driver.Get oBook0.Sheets("リスト").Cells(i, 10)
            
'        Application.Wait Now + TimeSerial(0, 0, 3)
           
        If driver.Window.Title = "警告:年齢確認が必要です" Then
            
           driver.FindElementByXPath("//*[text()='はい']").Click
            
        End If

        On Error Resume Next
        
        If oBook0.Sheets("リスト").Cells(i, 33) = "" Then
'            Application.Wait Now + TimeSerial(0, 0, 2)
'            oBook0.Sheets("リスト").Cells(i, 6) = oBook0.Sheets("リスト").Cells(i, 6) & vbCrLf & driver.FindElementByXPath("/html/body/div[2]/div[2]/div[5]/div[20]").Text
            
            
            
            
            sTmp = ""
            
            sTmp = Replace(driver.FindElementByXPath("/html/body/div[2]/div[2]/div[5]/div[2]/div/div/div/div/span").Text, "最後にこの商品を購入したのは", "")
            sTmp = Replace(sTmp, "注文の詳細を表示する", "")
            sTmp = Replace(sTmp, vbLf, "")
            sTmp = Replace(sTmp, "です。", "")

            If sTmp <> "" Then
                sTmp = sTmp & "購入"
            End If
            
            
            If sTmp <> "" Then
                oBook0.Sheets("リスト").Cells(i, 6) = sTmp & vbCrLf & oBook0.Sheets("リスト").Cells(i, 6)
                
                If driver.FindElementById("musicTracks_feature_div").Text <> "" And InStr(driver.FindElementById("musicTracks_feature_div").Text, "お客様がこれが役に立ったと考えています") = 0 Then
                    oBook0.Sheets("リスト").Cells(i, 6) = oBook0.Sheets("リスト").Cells(i, 6) & vbCrLf & vbCrLf & driver.FindElementById("musicTracks_feature_div").Text
                End If
                
                oBook0.Sheets("リスト").Cells(i, 6) = oBook0.Sheets("リスト").Cells(i, 6) & vbCrLf & vbCrLf & driver.FindElementById("productDescription_feature_div").Text

            Else
                
                If driver.FindElementById("musicTracks_feature_div").Text <> "" And InStr(driver.FindElementById("musicTracks_feature_div").Text, "お客様がこれが役に立ったと考えています") = 0 Then
                    oBook0.Sheets("リスト").Cells(i, 6) = oBook0.Sheets("リスト").Cells(i, 6) & vbCrLf & vbCrLf & driver.FindElementById("musicTracks_feature_div").Text
                End If
                
                oBook0.Sheets("リスト").Cells(i, 6) = oBook0.Sheets("リスト").Cells(i, 6) & vbCrLf & vbCrLf & driver.FindElementById("productDescription_feature_div").Text
            
            
            End If
        End If
        
        oBook0.Sheets("リスト").Cells(i, 33) = 1
        
        oBook0.Sheets("リスト").Cells(i, 12) = ""
        If driver.FindElementById("corePrice_feature_div").Text <> "" Then
            sTmp = ""
           
            sTmp = Replace(driver.FindElementById("corePrice_feature_div").Text, " 税込", "")
            sTmp = Replace(sTmp, "￥", "")
        
            oBook0.Sheets("リスト").Cells(i, 12) = sTmp
        End If
                                             

        'タイトル

        driver.Get oBook0.Sheets("リスト").Cells(i, 11)
        
        oBook0.Sheets("リスト").Cells(i, 13) = ""
        oBook0.Sheets("リスト").Cells(i, 14) = ""
        
'        Application.Wait Now + TimeSerial(0, 0, 3)
        
        oBook0.Sheets("リスト").Cells(i, 13) = driver.FindElementByXPath("/html/body/div[2]/span/span/span/div/div/div[4]/div[1]/div[2]/div/div/div[1]/div/div/span/div/span/span[2]/span[2]").Text 'タイトル
'        oBook0.Sheets("リスト").Cells(i, 13) = driver.FindElementByCss("#aod-price-1 > span > span:nth-child(2) > span.a-price-whole").Text 'タイトル
        oBook0.Sheets("リスト").Cells(i, 14) = driver.FindElementByCss("#unified-delivery-message-0").Text 'タイトル
        
        On Error GoTo 0
    
'        Application.Wait Now + TimeSerial(0, 0, 2)
        
    End If
    


Next i


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

メルカリ出品

エクセル上で、タイトル、説明文を編集し、さらに、上記で取得したamazonの価格を参考にして売価を編集します。

タイトルは、メルカリで自動設定された場合、文字数オーバーの部分はカットされていますが、エクセル上では、全文入力しておきます。宣伝tweetに使用します。

また、タイトルの冒頭17文字は、らくらくメルカリ便の伝票印字に流用しますので、冒頭17文字で取引品目が判別できるようなタイトルにしておきます。

編集後、本項のマクロを実行します。これにより、メルカリWEBサイト上のタイトル、説明文、価格が更新されます。

あわせて、マクロがTwitterで宣伝tweetをtweetします。

さらに、マクロがTwitter用のbotに 宣伝tweetを追加します。

check列に1を入れた行を対象に動きます。

Sub メルカリ出品(PROFILE_PATH As String, tweet_text As String, tweet_post As String, Selling_Edit_title As String, Selling_Edit_explanation As String, Selling_Edit_price As String, Selling_Edit_update As String)

Dim myBy As New By

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
Application.Wait Now + TimeSerial(0, 0, 3)


For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" Then


        oBook0.Sheets("PROFILE_PATH").Cells(3, 1) = 0

11:
        On Error GoTo ERR11
        
        Err.Number = 0
        
        If oBook0.Sheets("PROFILE_PATH").Cells(3, 1) < 6 Then
            On Error GoTo ERR11
        Else
            On Error GoTo 0
        End If

        driver.Get "https://jp.mercari.com/sell/edit/" & oBook0.Sheets("リスト").Cells(i, 2)

        Application.Wait Now + TimeSerial(0, 0, 1)


        'タイトル
        driver.FindElementByName(Selling_Edit_title).SendKeys ks.Control, "a"
        driver.FindElementByName(Selling_Edit_title).SendKeys ks.Delete
        driver.FindElementByName(Selling_Edit_title).SendKeys Mid(oBook0.Sheets("リスト").Cells(i, 4), 1, 40)
        

        'コメント
        driver.FindElementByName(Selling_Edit_explanation).SendKeys ks.Control, "a"
        driver.FindElementByName(Selling_Edit_explanation).SendKeys ks.Delete
        driver.FindElementByName(Selling_Edit_explanation).SendKeys Replace(oBook0.Sheets("リスト").Cells(i, 6), vbTab, " ")

        '売価
        driver.FindElementByName(Selling_Edit_price).SendKeys ks.Control, "a"
        driver.FindElementByName(Selling_Edit_price).SendKeys ks.Delete

        driver.FindElementByName(Selling_Edit_price).SendKeys oBook0.Sheets("リスト").Cells(i, 8)

        
        driver.FindElementByXPath(Selling_Edit_update).Click
        
        Application.Wait Now + TimeSerial(0, 0, 1)
        
        If driver.IsElementPresent(myBy.XPath("//*[text()='このまま出品する']")) Then
            driver.FindElementByXPath("//*[text()='このまま出品する']").Click
        
        End If
        
        Application.Wait Now + TimeSerial(0, 0, 1)
        
        
        On Error GoTo 0

        If oBook0.Sheets("リスト").Cells(i, 18) <> "" Then
            driver.Get "https://twitter.com/compose/tweet"
        
            driver.FindElementByXPath(tweet_text).SendKeys oBook0.Sheets("リスト").Cells(i, 18)
            driver.FindElementByXPath(tweet_post).Click


            Workbooks.Open "M:\ピクチャー\コミック\Twitter_BOT.xlsm"
        
            Endrow2 = Workbooks("Twitter_BOT.xlsm").Sheets("TWEET").Cells(1048576, 1).End(xlUp).Row
        
            Workbooks("Twitter_BOT.xlsm").Sheets("TWEET").Cells(Endrow2 + 1, 1) = oBook0.Sheets("リスト").Cells(i, 18)
        
            Workbooks("Twitter_BOT.xlsm").Save
        
            Workbooks("Twitter_BOT.xlsm").Close
        
        End If
        
        oBook0.Sheets("リスト").Cells(i, 21) = oBook0.Sheets("リスト").Cells(i, 8)

        oBook0.Sheets("リスト").Cells(i, 1) = ""

    End If
    


Next i


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues


Exit Sub
    
ERR11:
    Windows(oBook0.Name).Activate
    oBook0.Sheets("PROFILE_PATH").Cells(3, 1) = oBook0.Sheets("PROFILE_PATH").Cells(3, 1) + 1
    Resume 11

End Sub

コードの中の、「tweet_text, tweet_post」にセットする値は以下記事を参照ください。

chromeでX(旧Twitter)にポスト(tweet)するExcelマクロ(VBA)

FIREを目指し、収入増加を目的にSNS運用をしているものの、時間の制約から、効率化に課題を感じている方、多いのではないかと思います この記事では、VBAでchromeを使ってX(Twitter)にポスト(tweet)する方法を紹介します。SNS運用の参考にしていただければ幸いです

hineke.jp

2021.07.18

メルカリ_購入お礼

商品が売れた際に、お礼のコメントを入力するマクロです。

check列に1を入れた行を対象に動きます。

購入日時を取得し、購入日時の7日後に出荷予定である旨コメントに付記する機能をつけています。

また、宣伝tweet用のbotを削除する機能をつけています。

Sub メルカリ_購入お礼(PROFILE_PATH As String, Tran_Selling_date As String, Tran_Selling_message As String, Tran_Selling_send_message As String)

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
Application.Wait Now + TimeSerial(0, 0, 3)
driver.Window.Maximize


For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" And oBook0.Sheets("リスト").Cells(i, 3) = "出品中" Then



        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)

        Application.Wait Now + TimeSerial(0, 0, 2)

        oBook0.Sheets("リスト").Cells(i, 20) = CDate(Mid(driver.FindElementByXPath(Tran_Selling_date).Text, 1, InStr(driver.FindElementByXPath(Tran_Selling_date).Text, "日"))) + 7


        driver.FindElementByName(Tran_Selling_message).SendKeys "お世話になります。この度はご購入いただきありがとうございます。出品者のFIRE太郎と申します。短い間ですが、お取引終了までよろしくお願いいたします。" & Format(oBook0.Sheets("リスト").Cells(i, 20), "yy/mm/dd(aaa)") & "の発送を予定しております。発送まで、今しばらくお待ちください"

        driver.FindElementByXPath(Tran_Selling_send_message).Click



        Workbooks.Open "M:\ピクチャー\コミック\Twitter_BOT.xlsm"
        
        Set oBook1 = ActiveWorkbook
            
        For n = 2 To oBook1.Sheets("TWEET").Cells(Rows.Count, 1).End(xlUp).Row

            If InStr(oBook1.Sheets("TWEET").Cells(n, 1), oBook0.Sheets("リスト").Cells(i, 2)) > 0 Then
            
                oBook1.Sheets("TWEET").Rows(n).Delete
                
                Exit For
            End If

        Next n

        Workbooks("Twitter_BOT.xlsm").Save

        Workbooks("Twitter_BOT.xlsm").Close



        oBook0.Sheets("リスト").Cells(i, 3) = "取引中"
        
        oBook0.Sheets("リスト").Cells(i, 1) = ""


    End If

Next i

Application.Wait Now + TimeSerial(0, 0, 3)


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

メルカリ発送準備

発送準備用のマクロです。

check列に1を入れた行を対象に動きます。

発送方法が、ファミリーマート＆ネコポスの場合と、 セブンイレブン＆ネコポスにのみ対応しています。

QRコード取得までを実行します。

商品名は、エクセルシート上の「メルカリ件名」から取得します。（文字数オーバー分はカットします）

＜商品名についての補足＞

商品名には商品概要（CD,Blu-rayなど）の記載が必要です。記載していないと航空輸送可能な安全な貨物か否かの判断が出来なくなるため、航空便に乗りません。

航空便に乗らないと、北海道など、航空便の選択が適切な送付先に対し、陸路・船便で輸送されてしまい、到着にとても時間がかかってしまいます。

それから商品名には、商品固有名を記載したほうがよいです。

複数コンビニに持ち込んだ場合に、添付する出荷票に商品固有名が印字されるため、どの現物商品に、どの出荷票を添付すればよいか判別できるようになるためです。

よって、商品名はまじめに記載したほうがよいのですが、スマホで作業すると地味に面倒くさいため、自動的に設定する機能を作りました。

Sub メルカリ_発送準備_ファミマ_ネコポス(PROFILE_PATH As String, Tran_Selling_selection_size As String, Tran_Selling_selection_nekopos As String, Tran_Selling_selection_next As String, Tran_Selling_famima As String, Tran_Selling_selection_end As String, Tran_Selling_productname As String, Tran_Selling_QR As String)

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
driver.Window.Maximize
Application.Wait Now + TimeSerial(0, 0, 3)

For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" Then

        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)
        Application.Wait Now + TimeSerial(0, 0, 3)
        
        driver.FindElementByXPath(Tran_Selling_selection_size).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_nekopos).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_next).Click
        
        driver.FindElementByXPath(Tran_Selling_famima).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_end).Click
        

        driver.FindElementByName(Tran_Selling_productname).SendKeys ks.Control, "a"
        driver.FindElementByName(Tran_Selling_productname).SendKeys ks.Control, Delete
        Application.Wait Now + TimeSerial(0, 0, 1)
        driver.FindElementByName(Tran_Selling_productname).SendKeys Mid(oBook0.Sheets("リスト").Cells(i, 4), 1, 17)

        driver.FindElementByXPath(Tran_Selling_QR).Click
        
        Application.Wait Now + TimeSerial(0, 0, 1)

        
        oBook0.Sheets("リスト").Cells(i, 1) = ""
        
    End If
    


Next i

Application.Wait Now + TimeSerial(0, 0, 3)


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

Sub メルカリ_発送準備_セブン_ネコポス(PROFILE_PATH As String, Tran_Selling_selection_size As String, Tran_Selling_selection_nekopos As String, Tran_Selling_selection_next As String, Tran_Selling_711 As String, Tran_Selling_selection_end As String, Tran_Selling_productname As String, Tran_Selling_barcode As String)


Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
driver.Window.Maximize

For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" Then

        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)
        Application.Wait Now + TimeSerial(0, 0, 3)
        
        driver.FindElementByXPath(Tran_Selling_selection_size).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_nekopos).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_next).Click
        
        driver.FindElementByXPath(Tran_Selling_711).Click
        
        driver.FindElementByXPath(Tran_Selling_selection_end).Click
        

        driver.FindElementByName(Tran_Selling_productname).SendKeys ks.Control, "a"
        driver.FindElementByName(Tran_Selling_productname).SendKeys ks.Control, Delete
        Application.Wait Now + TimeSerial(0, 0, 1)
        driver.FindElementByName(Tran_Selling_productname).SendKeys Mid(oBook0.Sheets("リスト").Cells(i, 4), 1, 17)

        driver.FindElementByXPath(Tran_Selling_barcode).Click
        
        Application.Wait Now + TimeSerial(0, 0, 1)

        
        oBook0.Sheets("リスト").Cells(i, 1) = ""
        
    End If
    


Next i

Application.Wait Now + TimeSerial(0, 0, 3)


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

メルカリ出荷通知

出荷通知と出荷した旨のコメントを入力するマクロです。

check列に1を入れた行を対象に動きます。

ネコポスに対応しています。

Sub メルカリ_出荷通知(PROFILE_PATH As String, Tran_Selling_shipping As String, Tran_Selling_shipping_agreement As String, Tran_Selling_message As String, Tran_Selling_send_message As String)

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
driver.Window.Maximize

For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" And oBook0.Sheets("リスト").Cells(i, 3) = "取引中" And oBook0.Sheets("リスト").Cells(i, 20) <> "" Then

        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)
        
        Application.Wait Now + TimeSerial(0, 0, 2)
        
        driver.FindElementByXPath(Tran_Selling_shipping).Click

        driver.FindElementByXPath(Tran_Selling_shipping_agreement).Click

        Application.Wait Now + TimeSerial(0, 0, 2)
        
        driver.FindElementByName(Tran_Selling_message).SendKeys "お世話になります。先ほど発送手続を完了しました。お手数ですが商品が到着しましたら、受け取り評価をお願いします。"

        driver.FindElementByXPath(Tran_Selling_send_message).Click

        oBook0.Sheets("リスト").Cells(i, 3) = "出荷済"
        
        oBook0.Sheets("リスト").Cells(i, 1) = ""


    End If

Next i

Application.Wait Now + TimeSerial(0, 0, 3)


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

メルカリ_評価

商品が受取評価された際に、購入者の評価を実施するマクロです。

あわせて、取引結果をエクセル管理台帳に取得する機能を設けています。購入日時・販売価格・手数料・送料等を取得します。

check列に1を入れた行を対象に動きます。

Sub メルカリ_評価(PROFILE_PATH As String, Tran_Selling_evaluation_message As String, Tran_Selling_evaluation_send As String, Tran_Selling_close_date As String, Tran_Selling_close_price As String, Tran_Selling_close_commission As String, Tran_Selling_close_DeliveryCharge As String, Tran_Selling_close_profit As String, Tran_Selling_close_postage As String, Tran_Selling_close_buyer As String, Tran_Selling_transaction_completed As String)

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

driver.AddArgument ("user-data-dir=" & PROFILE_PATH)

driver.Start "chrome"
Application.Wait Now + TimeSerial(0, 0, 2)
driver.Window.Maximize

For i = 3 To oBook0.Sheets("リスト").Cells(Rows.Count, 2).End(xlUp).Row

    If oBook0.Sheets("リスト").Cells(i, 1) <> "" Then

        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)
        Application.Wait Now + TimeSerial(0, 0, 2)

        driver.FindElementByName(Tran_Selling_evaluation_message).SendKeys "このたびは購入ありがとうございました。スムーズな取引をしていただいて感謝しています。また機会がありましたらよろしくお願いいたします。"


        driver.FindElementByXPath(Tran_Selling_evaluation_send).Click

        driver.FindElementByXPath(Tran_Selling_transaction_completed).Click
        Application.Wait Now + TimeSerial(0, 0, 2)

        driver.Get "https://jp.mercari.com/transaction/" & oBook0.Sheets("リスト").Cells(i, 2)
        
        
        oBook0.Sheets("リスト").Cells(i, 22) = CDate(Mid(driver.FindElementByXPath(Tran_Selling_close_date).Text, 1, InStr(driver.FindElementByXPath(Tran_Selling_close_date).Text, "日")))
        oBook0.Sheets("リスト").Cells(i, 23) = Mid(driver.FindElementByXPath(Tran_Selling_close_price).Text, 2, 100)
        oBook0.Sheets("リスト").Cells(i, 24) = Mid(driver.FindElementByXPath(Tran_Selling_close_commission).Text, 2, 100)
        oBook0.Sheets("リスト").Cells(i, 25) = Mid(driver.FindElementByXPath(Tran_Selling_close_DeliveryCharge).Text, 2, 100)
        oBook0.Sheets("リスト").Cells(i, 26) = Mid(driver.FindElementByXPath(Tran_Selling_close_profit).Text, 2, 100)
        oBook0.Sheets("リスト").Cells(i, 27) = driver.FindElementByXPath(Tran_Selling_close_postage).Text
        oBook0.Sheets("リスト").Cells(i, 28) = Mid(driver.FindElementByXPath(Tran_Selling_close_buyer).Text, 1, InStr(driver.FindElementByXPath(Tran_Selling_close_buyer).Text, vbLf) - 1)
        oBook0.Sheets("リスト").Cells(i, 29) = Date

        
        oBook0.Sheets("リスト").Cells(i, 3) = "取引終了"
        
        oBook0.Sheets("リスト").Cells(i, 1) = ""

    End If
    


Next i

Application.Wait Now + TimeSerial(0, 0, 3)


Set driver = Nothing

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="<>取引終了", Operator:=xlFilterValues

End Sub

その他機能

メルカリ過去の取引履歴取得

メルカリの、過去の取引履歴を一括でエクセルに取得します。

マクロの動画状況の動画は以下の通り。

この機能は以下リンク先のココナラで販売しています。

メルカリ販売履歴を1クリックでエクセルに取得します メルカリの販売履歴をエクセルに取得するマクロ | 作業自動化・効率化 | ココナラ

メルカリの、取引完了した販売履歴をエクセルに一括で取得するマクロです。取得する項目は、以下です。商品名商品の説明購入日商品代金販売手数料配送料販売利益送料購入者...

coconala.com

メルカリ販売価格更新

メルカリの販売価格をエクセル上で編集後、一括でメルカリに反映するマクロです。

check列に1を入れた行を対象に動きます。

check列に1が一つも入っていない場合は、売値が変更された全ての行を対象に動きます。

この機能は以下リンク先のココナラで販売しています。

メルカリの販売価格をVBAで一括で更新します メルカリの販売価格を一括で更新するVBAマクロ | 作業自動化・効率化 | ココナラ

メルカリの販売価格を一括で更新するVBAマクロです。まず、マクロが、エクセル上に出品リストを取得します。商品名、現販売価格など。（無料公開している機能です。本ペ...

coconala.com

フィルター（出品中）機能

ステータスが出品中と空白の行のみにフィルターをかける機能です。

よく使うので、エクセルシートに該当のマクロボタンを設置しています。

Sub フィルタ_出品中()

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

strCell = ActiveCell.Address

Range(oBook0.Sheets("リスト").Cells(3, 1), Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents

oBook0.Sheets("リスト").Cells(2, 1) = "ﾁｪｯｸ"

Range(strCell).Select

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="出品中", Operator:=xlOr, Criteria2:=""

ActiveWindow.SmallScroll Down:=-5000

フィルター（取引中）機能

ステータスが取引中と出荷済の出品IDにフィルターをかける機能です。

よく使うので、エクセルシートに該当のマクロボタンを設置しています。

Sub フィルタ_取引中()

Set oBook0 = ActiveWorkbook

If oBook0.Sheets("リスト").FilterMode = True Then

    oBook0.Sheets("リスト").ShowAllData
Else
    oBook0.Sheets("リスト").Rows(2).AutoFilter

End If

strCell = ActiveCell.Address

Range(oBook0.Sheets("リスト").Cells(3, 1), Cells(oBook0.Sheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents

oBook0.Sheets("リスト").Cells(2, 1) = "ﾁｪｯｸ"

Range(strCell).Select

oBook0.Sheets("リスト").Rows(2).AutoFilter Field:=3, Criteria1:="取引中", Operator:=xlOr, Criteria2:="出荷済"

ActiveWindow.SmallScroll Down:=-5000

End Sub

まとめ

いかがでしたでしょうか？

参考になれば幸いです。

本マクロブックのサポートやカスタマイズについては、条件によって、有償にて対応受付しております。

以下、クラウドワークスないしココナラのアカウントよりご依頼いただければ幸いです。

FIRE太郎さん(その他)に依頼・外注する | 簡単ネット発注なら【クラウドワークス】

日本最大級のクラウドソーシング「クラウドワークス」にご登録いただいているFIRE太郎さんのプロフィールです。その他のスキルを持つプロフェッショナルに1時間から仕事を気軽に発注！発注者は手数料無料。

crowdworks.jp

FIRE太郎さん(会社員)のプロフィール | ココナラ

Excelマクロ（VBA）による自動化ツールの作成が得意です。｜ブログ「FIRE（早期リタイア）研究所」運営中

coconala.com

また、メルカリについては、以下の記事を書いていますので、こちらも参考になれば幸いです。

副業としてのメルカリの採算性を時給ベースで考える

FIRE実現のため、副業でメルカリでの物販を実行・検討されている方、多いと思います。私も最近、メルカリで不要品の物販を試してみたのですが、副業として考えた時、いくらであれば採算が取れるといえるのか、計算してみたくなったので、当該計算結果についてシェアします。

hineke.jp

2021.07.31

メルカリ出品中の古いデータを削除するエクセルVBAマクロ

FIRE実現のために、メルカリで副業を実践しているものの、手間がかかって思うように捗らないという方、いらっしゃるかと思います。そこで、指定した件数よりも古いメルカリ出品中データを自動削除するエクセルVBAマクロを作成しましたので紹介します。...

hineke.jp

2022.10.29

メルカリの新規出品情報を取得するエクセルVBAツール

FIRE実現のために、メルカリで副業を実践しているものの、手間がかかって思うように捗らないという方、いらっしゃるかと思います。そこで、指定したキーワードでメルカリの新規出品情報を取得するエクセルVBAマクロを作成しましたので紹介します。参考...

hineke.jp

2022.10.23