いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。
"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。
http://officetanaka.net/excel/vba/file/file10.htm
例 空白→""、 神奈川→"神奈川"
やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。
Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook
Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select
’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With
’別のマクロ実行
End if
Next i1
’2行目、3行目と続く
End Sub
どうぞよろしくお願い致します。
No.3ベストアンサー
- 回答日時:
こんにちは。
>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。
ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?
Next j
Loop
.Close
End With
Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行
それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream
これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。
今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。
しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。
WindFaller様
アドバイスありがとうございました!
文字化けしてないCSVで試してみたところ
全列表示されたので、ファイル自体に問題があるのかもしれません。
もしかしたらまた質問するかもしれませんが
自分でも色々調べみようと思います。
ありがとうございました!
No.2
- 回答日時:
こんばんは。
補足は読んでおりませんので、そのままここにアップロードします。
エラー付きのコードを出していただいても、今ひとつはっきりしないので、ご質問の要点をまとめますと、
・CSVは、UTF-8 であること(ただし、BOMあり、BOMなし不明)
・ファイ名というシート名の部分のA2 からA列に対してCSVファイルの一覧があるということ。その数は不定であること。
・Sheet1 に連続してインポートしていくこと。
・その中の「""(コーテーションマーク)」は不要であると。(これは、Replaceを使うのが一般的です)
---------------------------
BOM付きなら、なんとかなるはずですが、このプログケラムには、UTF-8を選別することが出来ないという欠点があるので、UTF-8決まったものとします。このファイルのパスは、この実行しているワークブックと同じ場所にあるということになっていますので、場所が違う場合は適宜変えてくたさい。。
'//標準モジュール
Sub CSVImportCSV()
Dim Fname As String
Dim i As Long, j As Long
Dim myPath As String
Worksheets("Sheet1").UsedRange.Clear
myPath = ThisWorkbook.Path & "\" 'パス
With Worksheets("ファイル名")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Fname = myPath & .Cells(i, 1).Value
If Dir(Fname, vbNormal) <> "" Then 'ファイルの存在のチェック
Call CSVConverter(Fname)
Else
.Cells(i, 2).Value = "missing" 'ファイルがない場合は、B列に表示
End If
Next i
End With
End Sub
Private Sub CSVConverter(ByVal Fname As String)
Dim Strm As Object
Dim i As Long, j As Long
Dim buf As Variant
Dim sh As Worksheet
Dim Lastrow As Long
Set Strm = CreateObject("ADODB.Stream")
Set sh = Worksheets("Sheet1") '出力シート
i = sh.Cells(Rows.Count, 1).End(xlUp).Row '行の最後
With Strm
.Charset = "UTF-8" 'Encording
.Open
.LoadFromFile Fname
Do Until .EOS
buf = .ReadText(-2)
buf = Replace(buf, """", "")
arg = Split(buf, ",")
i = i + 1
For j = 0 To UBound(arg)
sh.Cells(i, j + 1) = arg(j)
Next j
Loop
.Close
End With
End Sub
No.1
- 回答日時:
こんにちは
いろいろ不明点はありますが・・・
>文字化けはしないものの文字に必ず""がついてしまい、
「"」が付け加えられるという意味でしょうか?
ご質問文ではそのように読めるけれど、そんなかとは無いのではないでしょうか。
元のCVSデータが、クォーテーション付きのCSVになっているだけではと推測しますが?
クォーテーションが邪魔であるなら、個別のデータにした時点で、『最初と、最後の1文字が"なら、両方取り除く』という処理を通るようにすれば外せると思います。
必ず、クォーテーション付きと決まっているなら、チェックの必要もなく、最初と最後の1文字を無条件で削除すれば良いでしょう。
>また一行しか転記されません。
転記された一行分は、最初の行でしょうか、最後の行でしょうか?
最初の一行であれば、二行目に移る前に処理が中断(または終了)していると推測できます。
最後の一行なら、全行処理しているけれど上書きしているなどの可能性が・・・
とはいえ、出力の行を制御している変数iの初期値設定がどこにも見当たらないけれど、エクセルマクロのデフォルトに任せてるって言うことでしょうか?
(行の制御では、特に問題にはならないかも知れませんが…)
ついでながら、ご提示のコードをざっと眺めて、わからない部分がいろいろと・・・
>Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
が実行される前に、
>Ssheet.Cells.Clear
でシート内をクリアしちゃってるけれど、Cells(i, 1).Valueで何を取得するつもりなのでしょうか?
さらには、その際の変数iはデフォルトだと空白(又は0)となっていて、セル参照に失敗するはずと思うのですが・・・
と言うものの、ご質問文ではファイルが読めているようなので、さっぱりわからないところです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) フォルダの場所を可変にしたいです(マクロ) 4 2023/05/11 10:00
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Excel(エクセル) Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード 4 2023/01/01 07:32
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
EXCELのVBAで画像を選んだ順に...
-
ハイパーリンクで前回値をひき...
-
Teraマクロで日付ディレクトリ...
-
excel INDIRECT 他ファイル参照
-
ファイルを並び替えるときの「...
-
Excelのマクロを実行しても、エ...
-
=CELL("filename")で取得したフ...
-
エクセルVBA+ADOで特定のCSVフ...
-
EXCELのマクロを使って、テキス...
-
EXCEL VBA ー 同一フォルダ内の...
-
PDF ファイルが開けません。
-
ローマ字→カタカナへ変換(エク...
-
マクロ 実行ボタンを押さずに...
-
Excel:コマンドボタンの移動
-
コマンドボタンを押すたびに大...
-
スクロールしてもボタンを常に...
-
Excel VBA のdebug(F8キー) が...
-
EXCELのセルへ、デジタル時計を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
EXCELのVBAで画像を選んだ順に...
-
Teraマクロで日付ディレクトリ...
-
エディタで効率的な切り出し方法
-
excel INDIRECT 他ファイル参照
-
VLOOKUP関数とネットワークに置...
-
エクセル 一括リンクの解除
-
エクセルからスキャナVBAで連動...
-
ハイパーリンクで前回値をひき...
-
ファイルを並び替えるときの「...
-
EXCELで複数のファイルから抽出
-
EXCEL VBA ー 同一フォルダ内の...
-
EXCELファイルが開けない(-_-;)
-
CSVで文字化けしてしまうのを直...
-
Excel VBAで自動的にハイパーリ...
-
PDF ファイルが開けません。
-
エクセルファイルから指定した...
-
EXCELのマクロを使って、テキス...
-
ファイルが無いときにエラーメ...
おすすめ情報
fujillin様
アドバイスありがとうございます。
色々説明不足で申し訳ございません。
クォーテーションですが実際のCSVにはついていません。マクロを実行するとついてしまいます。
>最初と最後の1文字を無条件で削除すれば良いでしょう。
ちなみにこちらは試して見たのですが上手く機能しませんでした(たぶん私のコードが間違えていると思います)
また、検証として↓だけで実行してみたところ
最後の行が貼り付け(?)されておらず
buf = .ReadText(-2) でデバッグになります。
そして1行目は正しく貼り付けされているのですが2行目はN列がA列に(N列以降はN,M,O..と順番通り)
3行目はO列がA列に(O列以降はP,Q,R..と順番通り)
4行目はN列がA列に(N列以降はN,M,O..と順番通り)
5行目はO列がA列に(O列以降はP,Q,R..と順番通り)
.
.
と、貼り付け場所がズレてしまいます。
>出力の行を制御している変数iの初期値設定
これが原因かと思うのですが、どこに入れたら良いか分からず、、、
出来ればA列の2行目から貼り付けたいです。
>Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
が実行される前に~
すみません。Ssheet.Cells(i, 1).Valueは
Rsheetの間違いで実際のコードにはRsheetと記載しています。
<検証用>
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス"
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With
アドバイスありがとうございます!
試してみたところ、一行目は無事に出来たのですが
そのあと"buf = .ReadText(-2)"で止まり
"パラメーターが間違っています"と表示されてしまいます。。。
アドバイスどうぞよろしくお願いします。
何度もありがとうございます!
参照設定にチェックを入れ、
Set Strm = Nothingを追加したら
"buf = .ReadText(-2)"で止まることはないものの
今度は一行目しか貼り付けされなくなってしまいました。。。
どうしたら良いのか迷走しています。。。