| |
VBA初学者です。
CSVを読み込み、C列の中でフィルターをかけ、フィルターで抽出された行、且つ、指定の列を転記したいと思っています。
書籍を２冊読み、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
|
|
マナ
- 24/5/22(水) 20:30 -
てんてん
- 24/5/22(水) 16:08 -
名無し
- 24/5/10(金) 12:13 -
- 24/4/2(火) 17:48 -
