ヤマトビジネスメンバーズ　発行ログCSVファイル

加工後の製品を発送する際、ほぼヤマトさんを利用しているのですが、
かなり以前に集荷に来られた方のお勧めで、ヤマトビジネスメンバーズを
利用してます。・・・リンクは無し！

伝票を発行した際のログがCSVファイルでダウンロード出来るのですが
ガッツリ丸ごとログな為、不要な部分を削除して印刷しておきたいんです。
正しくは、面倒なのでしたくないのですが、する必要に迫られやる事に
なりました。

不要な部分を考慮しないのであれば、ExcelにCSVを突っ込んで印刷で終了
なのですが、あまりに紙が無駄なので何とか対処したい所。

手動でチマチマはやっぱり面倒なので、頑張ってマクロにしました。

' vba
' ヤマトビジネスメンバーズ ログCSV

Option Explicit

Sub main()
    
    Application.ScreenUpdating = False

    ' csvインポート
    If Not importCsv Then
        GoTo finally
    End If
    
    ' 不要列削除
    Call removeColumns
    
    ' テーブル化
    Call initTable
    
    ' 調整
    Call setLayout

finally:
    Range("A1").Select
    Application.ScreenUpdating = True

End Sub

Private Sub setLayout()

    ' セルのフォーマット
    Columns("A:A").Select
    Selection.NumberFormatLocal = "0_ "
    
    ' カラム幅
    Columns("A:A").ColumnWidth = 15
    Columns("B:B").ColumnWidth = 10
    Columns("C:C").ColumnWidth = 15
    Columns("D:D").ColumnWidth = 30
    Columns("E:E").ColumnWidth = 30
    Columns("F:F").ColumnWidth = 10

    ' 用紙
    ActiveSheet.PageSetup.PaperSize = xlPaperA4
    ActiveSheet.PageSetup.Orientation = xlLandscape

End Sub

Private Sub initTable()

    ActiveSheet.ListObjects.Add( _
        xlSrcRange, _
        Range("A1").CurrentRegion, _
        , _
        xlYes _
    ).Name = "YAMATO"

End Sub

Private Sub removeColumns()

    Columns("Q:Q").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Delete Shift:=xlToLeft

    Columns("Q:AX").Delete Shift:=xlToLeft
    Columns("M:M").Delete Shift:=xlToLeft
    Columns("F:K").Delete Shift:=xlToLeft
    Columns("A:C").Delete Shift:=xlToLeft
    
End Sub

' https://excel-ubara.com/excelvba5/EXCEL111.html
Private Function importCsv() _
    As Boolean

    Dim varFileName As Variant
    Dim intFree As Integer
    Dim strRec As String
    Dim strSplit() As String
    Dim i As Long, j As Long, k As Long
    Dim lngQuote As Long
    Dim strCell As String

    importCsv = True

    varFileName = Application.GetOpenFilename( _
        FileFilter:="CSVファイル(*.csv),*.csv", _
        Title:="CSVファイルの選択")

    If varFileName = False Then
        Exit Function
    End If

    ' シートの追加
    Worksheets.Add After:=Worksheets(Worksheets.Count)

    intFree = FreeFile '空番号を取得
    Open varFileName For Input As #intFree 'CSVファィルをオープン
  
    i = 0
    Do Until EOF(intFree)
        Line Input #intFree, strRec '1行読み込み
        i = i + 1
        j = 0
        lngQuote = 0
        strCell = ""
        For k = 1 To Len(strRec)
            Select Case Mid(strRec, k, 1)
                Case "," '「"」が偶数なら区切り、奇数ならただの文字
                    If lngQuote Mod 2 = 0 Then
                        Call putCell(i, j, strCell, lngQuote)
                    Else
                        strCell = strCell & Mid(strRec, k, 1)
                    End If
                Case """" '「"」のカウントをとる
                    lngQuote = lngQuote + 1
                    strCell = strCell & Mid(strRec, k, 1)
                Case Else
                    strCell = strCell & Mid(strRec, k, 1)
            End Select
        Next
        '最終列の処理
        Call putCell(i, j, strCell, lngQuote)
    Loop
    Close #intFree

    importCsv = True
End Function

Private Sub putCell( _
    ByRef i As Long, _
    ByRef j As Long, _
    ByRef strCell As String, _
    ByRef lngQuote As Long)

    j = j + 1
    '「""」を「"」で置換
    strCell = Replace(strCell, """""", """")
    '前後の「"」を削除
    If strCell = """" Then
        strCell = ""
    ElseIf Left(strCell, 1) = """" And Right(strCell, 1) = """" Then
        strCell = Mid(strCell, 2, Len(strCell) - 2)
    End If
    Cells(i, j) = strCell
    strCell = ""
    lngQuote = 0
End Sub