【Excel VBA】在宅の副業で収入を得る【レベルや案件の獲得方法を紹介】

Sub TEST1()
    
    '請求書No.取得
    Dim No
    No = Worksheets("請求書").Cells(4, "H")
    
    Dim DB, A
    Set DB = Worksheets("DB")
    Set A = Worksheets("請求書")
    
    '最終行
    Dim LastRow
    LastRow = DB.Cells(Rows.Count, "A").End(xlUp).Row
    
    'データ貼り付け
    For i = 1 To LastRow
        If DB.Cells(i, 1) = No Then
            For j = 1 To 6
                A.Cells(j, "L") = DB.Cells(i, j + 1)
            Next
            Exit For
        End If
    Next
    
    'PDFに変換
    Dim FilePathPDF
    FilePathPDF = ThisWorkbook.Path & "\領収書.pdf"
    
    'PDFへ変換
    ThisWorkbook.ExportAsFixedFormat 0, FilePathPDF
        
End Sub

Sub TEST2()
    
    Dim A, DB
    ReDim DB(1 To 12, 1 To 8) As Variant
    
    'データを取得
    For i = 1 To 12
        Set A = Worksheets(i & "月")
        For j = 1 To 8
            DB(i, j) = A.Cells(j + 1, "B")
        Next
    Next
    
    '商品名を取得
    Dim Pr
    With Worksheets("1月")
        Pr = .Range("A1").Resize(7).Offset(1, 0)
    End With
    
    
    Dim B
    Set B = Worksheets("集計")
    
    'ファイルパス名
    Dim FilePath
    
    'データを集計して別ブック保存
    For i = 1 To UBound(Pr, 1)
        B.Range("B1") = Pr(i, 1)
        For j = 1 To UBound(DB, 1)
            B.Range("B3").Offset(j, 0) = DB(j, i)
        Next
        '別ブック保存
        B.Copy
        FilePath = ThisWorkbook.Path & "\商品：" & Pr(i, 1) & ".xlsx"
        ActiveWorkbook.SaveAs FilePath
        ActiveWorkbook.Close
    Next
    
End Sub

Sub TEST3()

    Dim Driver As New Selenium.WebDriver
    Dim SKey As New Selenium.Keys
    Dim Elm As Selenium.WebElement
    Dim Elms As Selenium.WebElements
    Dim Search As Selenium.WebElement
    
    Driver.AddArgument "--incognito" 'シークレットモード
    Driver.Start "chrome", "https://www.yahoo.co.jp/"
    Driver.Get "/"
    
    Dim SiteURL
    SiteURL = "https://www.mercari.com/" 'URL
    Dim ReURL
    
    With Worksheets("取得").Range("A1").CurrentRegion
        KeyWords = .Resize(.Rows.Count - 1, 1).Offset(1, 0)
    End With
    
    For k = 1 To UBound(KeyWords, 1)
        
        ReURL = ""
        
        If k = 1 Then
            '1回目の検索
            Set Search = Driver.FindElementByXPath("//*[@id=""ContentWrapper""]/header/section[1]/div/form/fieldset/span/input")
            Search.Clear
            Search.SendKeys KeyWords(k, 1)
            Search.SendKeys SKey.Enter
        Else
            '2回目以降の検索
            Driver.FindElementByCss("#header > div.Header__wrap > div > div.Header__innerItem > div.SearchBox.SearchBox--north.js-SearchBox--north > form > div.SearchBox__searchInputWrap > button").Click
            On Error Resume Next
            Set Search = Driver.FindElementByXPath("//*[@id=""header""]/div[1]/div/div[2]/div[1]/form/div[1]/input[1]")
            If Err.Number <> 0 Then
                Set Search = Driver.FindElementByXPath("//*[@id=""header""]/div[1]/div/div[1]/div[1]/form/div[1]/input[1]")
            End If
            Search.SendKeys KeyWords(k, 1)
            Search.SendKeys SKey.Enter
        End If
        
        '検索した結果の全体を取得
        Set Elm = Driver.FindElementByClass("Contents__innerGroupBody")
        
        '全体の記事をオブジェクトに格納
        Set Elms = Elm.FindElementsByClass("sw-CardBase")
        '
        '1記事ずつループ
        For Each Elm In Elms
            Set Elm = Elm.FindElementByTag("a")
            If InStr(Elm.Attribute("href"), SiteURL) > 0 Then
                ReURL = Elm.Attribute("href") 'URL
                Exit For
            End If
        Next
        
        'セルにURLを入力
        With Worksheets("取得")
            .Cells(k + 1, "B") = ReURL
        End With
        
    Next
    
    Driver.Close
    Set Driver = Nothing
    
End Sub