[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CSVﾌｧｲﾙから間引きしたﾃﾞｰﾀを抽出』（DANIEL）
1秒毎に200行のﾃﾞｰﾀが1時間分（72万行）出力されたCSVﾌｧｲﾙから
ｎ分ごとにﾃﾞｰﾀを抽出したいです。
VBAを自分なりに作成してみたのですが、
うまくいきません。
ご指導宜しくお願い致します。
Private Sub 間引き1分_Click()
Const myPath As String = "\\フォルダ１\"
Dim rIdx As Long
Dim X1 As Long
Dim X2 As Long
Dim M1 As Long
Dim M2 As Long
Dim fName As String
fName = Dir(myPath & "*.csv")
Do Until fName = ""
Workbooks.Open Filename:=myPath & fName
rIdx = rIdx + 1
Cells(rIdx, 20).Value = fName
Me.Range(Cells(1, 1), Cells(1, 19)).Value = ActiveSheet.Range("A1:S1").Value
X1 = 2
X2 = 201
M1 = 2
M2 = 201
Do Until X2 < 12000
Me.Range(Cells(X1, 1), Cells(X2, 19)).Value = ActiveSheet.Range("A" & M1 & ":S" & M2).Value
X1 = X1 + 200
X2 = X2 + 200
M1 = M1 + 12000
M2 = M2 + 12200
Loop
Windows(fName).Close
fName = Dir
Loop
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
一点だけ。 Do Until X2 < 12000 Untilは条件が満たされるまでループする。 なので上記だとX2が12000より小さくなるまでになるので１回で終了になってしまう。 Do Until X2 > 12000 では？ （ねむねむ） 2017/10/03(火) 15:56
エラーを報告する際にはどこで発生したかを報告してくれ。 少なくともこちらではSheet1にテストデータを作成して、Sheet2に抜き出すという形(CSVの読み込みはしていない) で試して抜き出されているのは確認した。 (抜き出されたデータが正しいのかまでは確認していないが） （ねむねむ） 2017/10/03(火) 16:06
ああ、 Do Until X2 > 12000 に変えたことでエラーが出るということはループ内か。 エラー時の抜出元セル範囲におかしなデータはないだろうか？ （ねむねむ） 2017/10/03(火) 17:00
質問とは直接関係無いんですが気になったので、
フォルダ内のCSVファイルを全て順番に読み込んで処理すると言うコードになってますが、 転記される側のシートのペースト位置は必ず2行目からになってますよね。 これだと最後に読み込んだCSVのデータしか反映されませんけど良いんですか？
後インデントを付けないと非常に見辛いです。
>M2 = M2 + 12200 は M2 = M2 + 12000 の間違いでは？
（sy） 2017/10/03(火) 21:09
インデントの件かしこまりました．
以後意識します．
M2 = M2 + 12000 の間違いでした．
ご指導ありがとうございます．
（DANIEL） 2017/10/03(火) 21:57
>「実行時エラー'13': 型が一致しません。」 に関しては今の情報だけでは私には理由は分かりません。 なので、 >質問にたいしての答えですが，良くないです． に対しての回答です。
X1 = 2 は1つ目のループより上に記述しないと、毎回リセットされてしまいますよ。
でもそうなると、 >Do Until X2 < 12000 ではまずいです。
でもよく考えると 2 から始まって 12000 を超えると終了なら、60回ループすると言う事なので、 ならFor Nextが使えますよね。 CSVの参照先は、For i = 0 To 60 としたら、i * 12000 + 2 で上の行は求められるので、 X1 だけ毎回200づつ加算すれば良いですよね。
後こう言う書き方はよくないです。
>Me.Range(Cells(1, 1), Cells(1, 19)).Value
CellsにもMe付けないと、今回は付けてもつけなくても同じシートを参照するので
結果オーライですけど、普通はエラーになりますよ。
おそらく右辺の方は同じ書き方をしてエラーになったから、変えたんじゃないですか？
シートモジュールに記述してるならMeは無くても良いです。
Range(Cells(1, 1), Cells(1, 19)).Value
シート装飾するならCellsにも、
Me.Range(Me.Cells(1, 1), Me.Cells(1, 19)).Value
でも変数使わないなら以下のような書き方が一般的と思います。
Range("A1:S1").Value = ActiveSheet.Range("A1:S1").Value
CellsはCellsでしか出来ない横方向へのループ以外では使わないのをお勧めします。 他ではデメリットしか思いつかないです。
（sy） 2017/10/04(水) 00:07
CSVのデータは必ず値なのでコピペでも良さそうですよね。 まぁ転記先のシートに書式設定とかしてたら駄目ですけど。
それと読込んだCSVを変数に格納すると、見やすくなると思います。
後セル範囲は200行19列と決まってるので、私はResizeを使う方法が記述がすっきりしてると感じます。 これは感性の問題なので、私ならと言うだけです。
For Next や コピペ、Resize を使うと以下のようになります。
Private Sub 間引き1分_Click()
Const myPath As String = "\\フォルダ１\"
Dim fName As String
Dim sh As Worksheet
Dim rIdx As Long
Dim X1 As Long
Dim i As Long
fName = Dir(myPath & "*.csv")
X1 = 2
Do Until fName = ""
Set sh = Workbooks.Open(Filename:=myPath & fName).Sheets(1)
rIdx = rIdx + 1
Range("T" & rIdx).Value = fName
If X1 = 2 Then sh.Range("A1:S1").Copy Range("A1")
For i = 0 To 59
sh.Range("A" & i * 12000 + 2).Resize(200, 19).Copy Range("A" & X1)
X1 = X1 + 200
Next i
Windows(fName).Close
fName = Dir
Loop
End Sub
コピペだと書式が壊れると言うなら、Value = Value の記述にして下さい。
（sy） 2017/10/04(水) 00:24
あつかましいお願いですが、もう一点お尋ねしたいのですが、
csvﾌｧｲﾙの中身は基本的に毎秒200*19作成されます。
測定の関係上、必ずしも毎秒ではなく欠損ﾃﾞｰﾀが存在してしまいます。
さらにその欠損ﾃﾞｰﾀは不規則であり、1ﾌｧｲﾙどのくらい欠落するか予測できません。
従って現状のプログラムの
For i = 0 To 59
ですと、次のcsvファイルのスタートは
12002からスタートしてしまうのですが、
前のﾃﾞｰﾀと連続してコピペする場合についてご指南いただけると幸いです。
（DANIEL） 2017/10/04(水) 09:48
>欠損ﾃﾞｰﾀは不規則であり、1ﾌｧｲﾙどのくらい欠落するか予測できません。 データの途中にも空白行が出来たりしますか？
全て転記後にソートが一番簡単ですけど、キーに出来る列はありますか？
もしくは200行19列固まりの中で、欠損データがあった場合、 必ずその固まりの中で最終行に値の入っている列はありますか？ あれば、転記後のその列の最終行を取得して、1行下から書き込む方法にするかですね。 此方は途中に空白行がある場合は対応出来ません。
それか全て転記後に、その列が空白の場合には必ず行全体が空白と判断出来る列が有るなら、 ジャンプ機能で空白のチェックして、行全体を削除でも出来ますね。
ソートやジャンプ機能はマクロ記録出来るので使えそうなら一度試してみてください。
（sy） 2017/10/04(水) 12:43
全て転記後のソートの方法で解決いたしました。
ご指摘・ご指導有難うございました。
（DANIEL） 2017/10/04(水) 15:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.