| 
    
     |  | VBA初学者です。 
 CSVを読み込み、C列の中でフィルターをかけ、フィルターで抽出された行、且つ、指定の列を転記したいと思っています。
 書籍を2冊読み、YouTubeなどで学び、chat GPTやcopilotなどで何とか、VBAを実行したいとトライしておりますが、うまくいきません。
 
 c列の中でのフィルターは抽出できました。
 抽出された横列がA-Zまでは抽出できていますが、AB列以降が抽出できない状況です。
 列の抽出のコードの書き方が間違っているのでしょうか。
 
 どなたかご教授ください。
 宜しくお願い致します。
 
 
 Sub C列でフィルター且つ列番号でデータ取得CSV()
 Dim ws As Worksheet
 Dim wsNew As Worksheet
 Dim csvFile As String
 Dim lastRow As Long
 Dim i As Long
 Dim newRow As Long
 Dim today As String
 Dim cValue As String
 Dim filterValues As Variant
 Dim columnsToCopy As Variant
 Dim colIndex As Long
 Dim copyColumn As Long
 
 ' フィルター対象の値を設定
 filterValues = Array("5", "11", "82", "402", "413", "421", "579", "580", "620")
 
 ' 転記する列を設定
 columnsToCopy = Array(1, 3, 4, 8, 21, 37, 56, 45, 48, 58, 62, 68, 70, 71, 73, 76, 84, 87, 20, 53)
 
 ' 今日の日付を取得してフォーマット
 today = Format(Date, "yyyymmdd")
 
 ' CSVファイルのパスを指定
 csvFile = Application.GetOpenFilename("CSVファイル (*.csv), *.csv")
 If csvFile = "False" Then Exit Sub ' ユーザーがキャンセルした場合
 
 ' 新しいワークシートを作成
 Set wsNew = ThisWorkbook.Sheets.Add
 wsNew.Name = "臨時進捗表_" & today
 
 ' CSVファイルを読み込むための一時的なワークシートを作成
 Set ws = ThisWorkbook.Sheets.Add
 ws.Name = "TempCSVData"
 
 ' CSVファイルを読み込み
 With ws.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=ws.Range("A1"))
 .TextFileParseType = xlDelimited
 .TextFileCommaDelimiter = True
 .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) ' 必要に応じて列数を変更
 .Refresh BackgroundQuery:=False
 End With
 
 ' データの最終行を取得
 lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 
 ' ヘッダーのコピー
 For i = LBound(columnsToCopy) To UBound(columnsToCopy)
 wsNew.Cells(1, i + 1).Value = ws.Cells(1, columnsToCopy(i)).Value
 Next i
 
 newRow = 2
 
 ' C列に指定された文字列が含まれる行を検索して指定の列を転記
 For i = 2 To lastRow ' ヘッダー行を飛ばして2行目から開始
 cValue = ws.Cells(i, 3).Value
 If Not IsError(Application.Match(cValue, filterValues, 0)) Then
 For colIndex = LBound(columnsToCopy) To UBound(columnsToCopy)
 copyColumn = columnsToCopy(colIndex)
 wsNew.Cells(newRow, colIndex + 1).Value = ws.Cells(i, copyColumn).Value
 Next colIndex
 newRow = newRow + 1
 End If
 Next i
 
 ' 一時的なワークシートを削除
 Application.DisplayAlerts = False
 ws.Delete
 Application.DisplayAlerts = True
 
 MsgBox "列番号でのデータ抽出が完了しました!", vbInformation
 End Sub
 
 
 |  |