VBA .csv 取り込み & データ抽出

■ 完成

■ シート説明

・マスター
VBAのボタンが配置されたシート

・読み込みデータ
csvファイルを読み込んだデータ

・抽出データ
読み込んだcsvから、指定のカラムを抽出したデータ

VBA ソース

・共通部分

Option Explicit

' 判定用　グローバル変数
Public loop_num As Integer

Public Sub global_var_init()
    ' グローバル変数　インクリメント
    loop_num = loop_num + 1
End Sub

・CSV取込み部分

Private Sub CommandButton1_Click()
    

' CSV取込み
Dim fileDialog As fileDialog
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)

Dim fileName As String


' ダイアログ処理
With fileDialog
    .Title = "CSVファイルを選択してください"
    .Filters.Clear
    .Filters.Add "CSVファイル", "*.csv"
    .AllowMultiSelect = False
    
  ' エラー処理
   If .Show = True Then
        fileName = .SelectedItems(1)
    Else
         MsgBox "ファイル読み込みエラー（既にファイルは読み込まれていませんか？）"
        Exit Sub
    End If

End With


' 新しいシート作成
Dim newSheet As Worksheet
Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))


newSheet.Name = "読み込みデータ"


'ファイルを開く
Open fileName For Input As #1

Dim lineText As String
Dim data() As String
Dim rowNum As Long

Dim i As Integer

rowNum = 1

ActiveSheet.Cells.Select
Selection.NumberFormatLocal = "@"

Do While Not EOF(1)
    Line Input #1, lineText
    data = Split(lineText, ",")
    '========= 新しいシートに表示する =========
    For i = 0 To UBound(data)
         newSheet.Cells(rowNum, i + 1) = Replace(data(i), """", "")
       ' newSheet.Cells(rowNum, i + 1) = data(i)
    Next i
    rowNum = rowNum + 1
Loop

Close #1

・読み込んだデータを抽出部分

Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastCol As Long
    Dim colIndex As Long
    Dim headerName As String
    
    ' コピー元シート
    Set wsSource = Worksheets("読み込みデータ")
    ' コピー先シート
    Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count))
    wsTarget.Name = "抽出シート"
    
     ' コピー元シートの最終列を取得
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
     ' 列名に特定の文字列が含まれている列をコピー
    For colIndex = 1 To lastCol
        headerName = wsSource.Cells(1, colIndex).Value
        If InStr(headerName, "納品日") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
            
            wsTarget.Columns(loop_num).AutoFit
      
        ElseIf InStr(headerName, "受注伝票番号") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
          
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
            
              wsTarget.Columns(loop_num).AutoFit
            
        ElseIf InStr(headerName, "受注伝票行") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
            
             wsTarget.Columns(loop_num).AutoFit
            
        ElseIf InStr(headerName, "伝票区分") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
            
              wsTarget.Columns(loop_num).AutoFit
        
         ElseIf InStr(headerName, "商品コード") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
              wsTarget.Columns(loop_num).AutoFit
        
         ElseIf InStr(headerName, "ＪＡＮコード") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
              wsTarget.Columns(loop_num).AutoFit
        
         ElseIf InStr(headerName, "商品名漢字") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
            
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
              wsTarget.Columns(loop_num).AutoFit
        
         ElseIf InStr(headerName, "店舗コード") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
            
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "商品分類コード") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "出荷数量") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "出荷確定日") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
          
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "検収数量") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "検収原価単価") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
          
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "検収原価金額") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "欠品区分") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
         ElseIf InStr(headerName, "理由") > 0 Then
            ' グローバル変数インクリメント
            Call global_var_init
           
            'コピー処理
            wsSource.Columns(colIndex).Copy wsTarget.Columns(loop_num)
             wsTarget.Columns(loop_num).AutoFit
            
        End If
    Next colIndex

End Sub