CSVのカンマ

質問

QNo.3002935「エクセルで開いていないbookのセルの値が欲しい 」の続きです。おかげさまで最大値を求めることができました。paopao01さんに感謝。今度は、-0.3以下のデータ個数を知りたく、MAX関数の後ろにCOUNTIF関数をつけてみました。

strLine = oFile.Name & "," & "=MAX('" & oTarget.Path & "\[" & oFile.Name & "]100ms'!G2:G2000)" & "," & "=COUNTIF('" & oTarget.Path & "\[" & oFile.Name & "]100ms'!G2:G2000" & Chr(44)&Chr(34)&"<=-0.3"&Chr(34)&")"

すると、途中のCOUNTIF内の　Chr(44)＝","カンマに反応しているようで、できあがったCSVファイルは
C列に「=COUNTIF('C:\Documents and Settings\Owner\デスクトップ\TEST\[001-1.xls]100ms'!G2:G2000」が入り、
D列には「<=-0.3)」がはいってしまい、演算が行われません。

解決方法をおしえてください。

回答No.1

noname#97729 · ベストアンサー

http://okwave.jp/qa3000160.html

こちらを参考に少し手直しさせてもらいました。

テスト環境で試して下さい。
1）新規ブックで ALT+F11を押下してVBEを開く
2）挿入－標準モジュールでモジュールを追加
3）下記のマクロをコピペし、VBEを閉じる
4）このブックを該当フォルダに保存（必ず）

Sub Test()
Dim myDir As String, myName As String, t As Integer
Dim str1 As String, cout1, cout2, cout3, cout4 As Integer
Application.ScreenUpdating = False
With ThisWorkbook
myDir = .Path & "\"
myName = Dir(myDir & "*.xls", vbNormal)

t = 1

Do While myName <> ""
If myName <> .Name Then
Set wb = Workbooks.Open(myDir & myName)

str1 = myName
cout1 = Application.Max(wb.Worksheets(1).Range("A1:A10"))
cout2 = Application.Min(wb.Worksheets(1).Range("A1:A10"))
cout3 = Application.Sum(wb.Worksheets(1).Range("A1:A10"))
cout4 = Application.CountIf(wb.Worksheets(1).Range("A1:A10"), ">5")

wb.Close

Cells(t, 1) = str1
Cells(t, 2) = cout1
Cells(t, 3) = cout2
Cells(t, 4) = cout3
Cells(t, 5) = cout4

t = t + 1

End If
myName = Dir
Loop

End With

End Sub

---------------------------------------------------
Rangeを適当な値にして下さい。
確認しましたが、ファイル３０個程度では問題ないようでした。

お礼

2000個のデータ処理が完了しました。
完璧です。再度多謝。

回答No.2

Wendy02

こんにちは。

COUNTIF関数 は、ひとつずつセルに当たり調べるので、ブックをオープンしないと出来ません。ですから、以下のような特別なCOUNTIF 関数を使うしか方法はなさそうです。

ただし、元のコードの
"=COUNTIF('" & oTarget.Path & "\[" & oFile.Name & "]100ms'!G2:G2000" & Chr(44)&Chr(34)&"<=-0.3"&Chr(34)&")"

ちょっと変です。以下は、1000個のシートでどのぐらいのスピードで出来上がるかは見当がつきませんが、マクロがうまく通れば、いずれは出力してくれるはずです。

Sub testCSV_Out()
　　Dim Fname As String
　　Dim buf1 As String
　　Dim buf2 As Variant
　　Dim buf3 As Variant
　　Dim arg As String
　　Dim myRng As String
　　Dim myFormula As String
　　Dim strLine As String
　　Dim arBuf() As String
　　Dim i As Long
　　Dim FNo As Integer
　　Const OutFNAME As String = "outData.CSV" 'CSV の名
　　Const myFOLDER As String = "C:\Documents and Settings\[ユーザー]\デスクトップ\test1Fold"
　　arg = """<=-0.3""" 'Countif の場合は、["] x 3

　　'テンポラリシートの増設
　　With ThisWorkbook
　　　　.Worksheets.Add After:=.Sheets(.Sheets.Count)
　　End With
　　ActiveSheet.Name = "tmp"

　　myRng = Range("G2:G2000").Address(1, 1, xlR1C1)
　　myFormula = "100ms'!" & myRng

　　Fname = Dir(myFOLDER & "\" & "*.xls")
　　Do While Fname <> ""
　　　　buf1 = Fname
　　　　buf2 = ExecuteExcel4Macro("MAX('" & myFOLDER & "\[" & Fname & "]" & myFormula & ")")
　　　　buf3 = MyCountIf(myFOLDER, Fname, "100ms", myRng, arg)
　　　　ReDim Preserve arBuf(i)
　　　　arBuf(i) = buf1 & "," & buf2 & "," & buf3
　　　　i = i + 1
　　　　Fname = Dir()
　　Loop

　　'CSV出力
　　FNo = FreeFile()
　　Open OutFNAME For Output As #FNo
　　For i = LBound(arBuf()) To UBound(arBuf())
　　　　Print #FNo, arBuf(i)
　　Next i
　　Close #FNo

　　On Error Resume Next
　　Application.DisplayAlerts = False
　　Worksheets("tmp").Delete
　　Application.DisplayAlerts = True
End Sub

Private Function MyCountIf(myPath As String, FileName As String, SheetName As String, myRng As String, arg As String)
　　Dim sht As Worksheet
　　Set sht = ThisWorkbook.Worksheets("tmp")
　　If myRng Like "R#*C#*" = False Then
　　　　myRng = Application.ConvertFormula(myRng, xlA1, xlR1C1)
　　End If
　　Application.ScreenUpdating = False
　　sht.Range("A1").Consolidate Sources:=Array("'" & myPath & "\[" & FileName & " ]" & SheetName & "'!" & myRng), Function:=xlSum
　　If Application.ReferenceStyle = xlR1C1 Then
　　　　MyCountIf = Evaluate("=COUNTIF(" & sht.Name & "!C1," & arg & ")")
　　Else
　　　　MyCountIf = Evaluate("=COUNTIF(" & sht.Name & "!A:A," & arg & ")")
　　End If
　　sht.Range("A:A").ClearContents
　　Application.ScreenUpdating = True
　　Exit Function
End Function

お礼

ありがとうございます。
参考にさせていただきます。