セルを検索して列番号を取得する方法は？

Question

excelのマクロで、指定したフォルダ内のcsvデータすべてに対して、「Di_DegC」と入力されているセルの列番号を取得してその列の平均値を取得し、平均値がある範囲内ならそのcsvファイルの名前を変更するというマクロを作りたいと考えています。

Sub Datarename()
Dim path, FSO, file, files
Dim ItemCol As Long
Dim LastRow As Long
Dim AVGC As Double

    path = Range("B2").Value

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set files = FSO.GetFolder(path).files

 For Each file In files

 If file.Name = "*.csv" Then
 
  ItemCol = file.Rows(1).Find("Di_DegC").Column
  LastRow = file.Columns("ItemCol").End(xlDown).Row

  AVGC = WorksheetFunction.Average(file.Range(Cells(ItemCol, 2), Cells(ItemCol, Lastlow)))
  
   If 120 < AVGC < 130 Then

    Name file As "*_WarmUp.csv"

   Else If 200< AVGC < 210 Then
   
    Name file As "*_Heat.CSV"

   End If

 End If

Next

MsgBox "完了"

End Sub

こちらのプログラムをかいたところ、
ItemCol = file.Rows(1).Find("Di_DegC").Column
ここで実行時エラー438が出ているようです。

1行目のどこかにあるDi_DegCを検索して列番号を返すプログラムだと思うのですが、何か間違っていますか？vba初心者につき教えていただけると助かります。

Answer 1

いろいろ間違ってますね。

1. file.Name = "*.csv".csvで終わるファイル名かチェックしているつもりでしょうが、ワイルドカード文字(*)を使う比較は=演算子ではなくLike演算子を使う必要があります。

2. 番号リストFileSystemObjectのfileオブジェクトにRowsとかColumnsとかありません。Excelのワークシートのプロパティですので、CSVファイルをワークブックとして開く必要があります。

3. 120 < AVGC < 130 このような比較はできません。120 < AVGC AND AVGC < 130 と一つずつ比較する必要があります。

4. Name file As "*_WarmUp.csv" Nameステートメント(ファイル名変更命令)ではワイルドカード文字(*)は使えません。また、引数にflieオブジェクトではなく、ファイルのフルパスを指定する必要があります。

他にもありますが、もろもろ考慮して修正すると、下記のようになります。

Sub Datarename()
    Dim path, FSO, file, files
    Dim ItemCol As Long
    Dim LastRow As Long
    Dim AVGC As Double

    path = Range("B2").Value

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set files = FSO.GetFolder(path).files

    For Each file In files

        If file.Name Like "*.csv" Then
            Dim wb As Workbook
            Set wb = Workbooks.Open(file.path) 'CSVファイルをワークブックとして開く
            Dim ws As Worksheet
            Set ws = wb.Worksheets(1) '開いたブックのワークシート
            
            ItemCol = ws.Rows(1).Find("Di_DegC").Column
            LastRow = ws.Columns(ItemCol).End(xlDown).Row

            AVGC = WorksheetFunction.Average(ws.Range(ws.Cells(ItemCol, 2), ws.Cells(ItemCol, Lastlow)))

            wb.Close SaveChanges:=False '開いたブックを閉じる
            
            If 120 < AVGC And AVGC < 130 Then

                Name file.path As Replace(file.path, ".csv", "_WarmUp.csv")

            ElseIf 200 < AVGC And AVGC < 210 Then

                Name file.path As Replace(file.path, ".csv", "_Heat.CSV")

            End If

        End If

    Next

    MsgBox "完了"

End Sub

動作確認はしてないので、チェック漏れがあるかもしれません。エラー等が出ましたら、どこでどのようなエラーがでたかコメントしてください。

Comments

[nekosyokupan]

返信ありがとうございます。こちらのプログラム、
LastRow = ws.Columns("ItemCol").End(xlDown).Row
この行でエラーが出ましたがColumns以降のカッコの""を消すとうまく動いてやりたかったことができるようになりました。
bva初めてでしたので助かりました。ありがとうございました。

[hatena19]

おっと、やはり間違いがありましたか。
回答の方は修正しておきます。