Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

108 / 76735

←次へ　｜　前へ→


	【82298】セルの改行が影響してエクセルへの抽出結果が思うようにできない

VBA初学者です_T - 24/5/29(水) 15:41 -


	引用なし

	パスワード

先日、こちらにてお世話になりました。
表題の件、
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

4 hits

▼

【82298】セルの改行が影響してエクセルへの抽出結果が思うようにできない VBA初学者です_T 24/5/29(水) 15:41