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 回答日時： 2007/05/31 07:57

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個のデータ処理が完了しました。
完璧です。再度多謝。

お礼日時：2007/06/02 02:06

No.2 回答者： Wendy02 回答日時： 2007/05/31 18:17

こんにちは。

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
　　

この回答へのお礼

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

お礼日時：2007/06/02 02:08