| |
先日、こちらにてお世話になりました。
表題の件、
csvファイルからエクセルシートへのデータ取得の際、セルの中に改行がある場合、一行に表示されるはずのデータが下のセルへ下のセルへ縦にデータが抽出されます。
どのように記述すれば解決するか、教えていただける方、いらっしゃいませんか？
宜しくお願い致します。
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
|
|
Jaka
- 24/6/17(月) 2:27 -
せい
- 24/6/15(土) 6:45 -
なんでやねん
- 24/6/6(木) 11:43 -
