色彩検定1級を取得する魅力を紹介♪

Sub CSV入力2()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long, k As Long
Dim lngQuote As Long
Dim strCell As String


varFileName = Application.GetOpenFilename(FileFilter:="210513(*.csv),*.csv", _
Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If

intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'CSVファィルをオープン

i = 0
Do Until EOF(intFree)
Line Input #intFree, strRec '1行読み込み
i = i + 1
j = 0
lngQuote = 0
strCell = ""
For k = 1 To Len(strRec)
Select Case Mid(strRec, k, 1)
Case "," '「"」が偶数なら区切り、奇数ならただの文字
If lngQuote Mod 2 = 0 Then
Call PutCell(i, j, strCell, lngQuote)
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case """" '「"」のカウントをとる
lngQuote = lngQuote + 1
strCell = strCell & Mid(strRec, k, 1)
Case Else
strCell = strCell & Mid(strRec, k, 1)
End Select
Next
'最終列の処理
Call PutCell(i, j, strCell, lngQuote)
Loop
Close #intFree
End Sub

Sub PutCell(ByRef i As Long, ByRef j As Long, ByRef strCell As String, ByRef lngQuote As Long)
j = j + 1
'「""」を「"」で置換
strCell = Replace(strCell, """""", """")
'前後の「"」を削除
If Left(strCell, 1) = """" And Right(strCell, 1) = """" Then
strCell = Mid(strCell, 2, Len(strCell) - 2)
End If
Cells(i, j) = strCell
strCell = ""
lngQuote = 0
End Sub


上記のようなCSVファイルの書き出しのコードを見つけて実行してみました。
できたのですが、希望は、書き出す時に行と列を入れ替えて書き出したいのですがどこを変更したらいいでしょうか?

また、次に書き出す時は次の列から書き出したいのです。

お願いします。教えてください。

質問者からの補足コメント

  • うーん・・・

    できましたw
    ちなみに教えてください。
    色々な事を書き出してくれるのですが、必要な数値だけかきだす事って可能でしょうか?

    No.1の回答に寄せられた補足コメントです。 補足日時:2021/05/14 12:54
gooドクター

A 回答 (3件)

#1です


>必要な数値だけかきだす事
意味する所が分からないのですが、数値以外は不要と言う事でしょうか?

ご質問のコードで出力データを加工するのであれば、書き出し前の
Cells(i, j) = strCell の上行で処理すれば良いと思います。

数値のみにする場合は、正規表現などを使用して加工するのはどうでしょう

具体的には、(Cells(i, j) = strCellを含め書き換えて)

文字列=文字&数値&文字&数値&文字、、、を想定

Dim reMch, reVl, Nu
With CreateObject("VBScript.RegExp")
.Pattern = "[0-9,.]+"  '数値の塊
.Global = True
Set reMch = .Execute(strCell)
If reMch.Count > 0 Then
For Each reVl In reMch
Nu = Nu & reVl
Next
End If
End With
Cells(j, i) = Nu
(変数名適当)
結果は数値&数値&・・・となると思います。
初めの数値のみで良ければ Nu = Nu & reVl:ExitFor
初めと次の数値の区切りを付加するならNu = Nu & reVl & "区切り文字"
最後に右1文字を削除

更に条件で絞るなら、出力前で加工すれば良いと思います。

ファンクションなどにした方が良いかもですが、
後付けなので取敢えずですが、解釈が違っていたらごめんなさい。

余談
ご質問のコードは昔、試した事があります。
結局使う事はなかったのですが、、
#2様がアドバイスされている通り、1文字ずつ処理をするより
QueryTables(CSVインポートウイザードで記録されるマクロ)などで
シートにデータを取得して、データ範囲をTranspose=Trueでコピペ
した方が良いかもです。QueryTablesに数値のみにするメソッドがあったかは、不明ですけれどね
    • good
    • 0

こんにちは



ざっとしか見ていませんが・・・

ご提示のコードはCSVを1行ずつ読み込んで解釈しているようですが、エクセルはCSVファイルを読み込めるので、直接読み込ませた方が簡単です。
(面倒なクォーテーションの処理などしなくてもよくなります)

>書き出す時に行と列を入れ替えて書き出したいのですが
>どこを変更したらいいでしょうか?
変更というよりも、上で述べたように
 1)新しいブックとしてCSVを開く。
 2)データ全体をTransposeしてコピペ。
 3)CSVのブックを閉じる(保存しない)
の手順で行うのが簡単だと思います。

>また、次に書き出す時は次の列から書き出したいのです。
上の2)のペーストの際に、
書き出し側のUsedRange以降、あるいは、お決まりのEnd(xlUp)で最終行を調べてその次の行からペーストするようにすれば宜しいかと。

順次書き加えていくと、どこかで行数オーバーになる可能性があるので、事前にする必要があるのかも知れません。
    • good
    • 0

こんにちは、さっくりなので違うかもですが


i j 共にループでないカウント変数なので
書き出しコードの i j を入れ替えると、、どうでしょう?
Cells(j, i) = strCell
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング