複数ファイルの１つのシート中の総行数を求めるには

質問

大変お世話になっております。
複数ファイルの１つのシート(カテーログ)中の最終行数を求めるのに、下記のマクロを書いて実行しましたが、エラーは出ませんが総行数など、何も反応がありません。なにも出力しない原因がお分かりでしたら、ご教示頂けると大変たすかります。まだまだマクロは超初心者です。
出力したい情報は、ファイル名とA列の3行目～最終行の総行数です。
Sub データ総行数求め()
Dim fpath As String, fname As String
Dim wb As Workbook, ws As Worksheet
Dim crow As Long, cnt As Long

fpath = "C:\Users\Owner\Documents\連結作業\202304-202309\)"
fname = Dir(fpath & "*.xlsx")
Set ws = ThisWorkbook.Worksheets("test")

crow = 1
Do Until (fname = "")
Set wb = Workbooks.Open(fpath & fname)

If (sheet_chk(wb, "カテーログ") = True) Then
cnt = count_row(wb.Worksheets("カテーログ"))

Worksheets("カテーログ").Range("A3").Value

ws.Cells(crow, 1).Value = fname
ws.Cells(crow, 2).Value = "カテーログ"
ws.Cells(crow, 3).Value = cnt

crow = crow + 1
End If
wb.Close
fname = Dir()
Loop
End Sub

'戻り値の定義
Function count_row(ByVal ws As Worksheet) As Long
Dim k As Long, tmp As Long

count_row = 0
For k = 1 To 256
tmp = ws.Cells(ws.Rows.Count, k).End(xlUp).Row
If (tmp > count_row) Then count_row = tmp
Next
End Function

Function sheet_chk(ByVal wb As Workbook, ByVal msg As String) As Boolean
Dim w As Worksheet

sheet_chk = False
For Each w In wb.Worksheets
If (w.Name = msg) Then
sheet_chk = True
Exit For
End If
Next
End Function

回答No.2

SI299792 · ベストアンサー

３行目からという事は 2引けばいいのですね

tmp = ws.Cells(ws.Rows.Count, k).End(xlUp).Row - 2
でうまく行くと思います。

For k = 1 To 256
これは、列です 256といえば、IV列です。
Ａ～IV列で、最終行を調べて、最大値を返しています。
IV列以右を使っていない限り、問題ありません。
（本来なら、XFD 列迄調べるべきでしょうが、無駄に時間がかかるので、IV列迄にしてあるのでしょう。又は昔IV列迄しかない時代に作られたものかもしれません）

それにしても、このプログラム無駄に長すぎます。ネットにプログラムを上げる人は、どうして無駄に効率の悪いプログラムを上げるのでしょうか。
私なら、フォルダ名、シート名をセルに入れ、変更があってもプログラムの変更なしでできるようにします。こうすれば、貴方がやったようなミスを防げます。
プログラムもこれだけです。
実行速度も上がると思います。
Option Explicit
'
Sub Macro1()
　　Dim Sh As Worksheet
　　Dim FileName As String
　　Dim ROut As Long
'
　　Set Sh = ThisWorkbook.ActiveSheet
　　ROut = 6
　　FileName = Dir([B1] & "\*.xls*")
'
　　If FileName = "" Then
　　　　MsgBox "フォルダ又はファイルがありません", vbCritical
　　End If
　　Range("A6:B" & Rows.Count).ClearContents
　　Application.ScreenUpdating = False
'
　　Do While FileName > ""
　　　　Workbooks.Open Sh.[B1] & "\" & FileName, False, True
　　　　On Error Resume Next
　　　　Sheets(Sh.[B2].Value).Select
'
　　　　If Err = 0 Then
　　　　　　Sh.Cells(ROut, "A") = FileName
　　　　　　Sh.Cells(ROut, "B") = _
　　　　　　　　[A1].SpecialCells(xlCellTypeLastCell).Row - Sh.[B3] + 1
　　　　　　ROut = ROut + 1
　　　　End If
　　　　On Error GoTo 0
　　　　Workbooks(FileName).Close False
　　　　FileName = Dir
　　Loop
End Sub

お礼

紹介頂いたコードへ総データ数を入れ込み、表示されたデータもテーブル形式で表示出来るようになりました。ご紹介頂きましたコードは今回もVBAの勉強に大変役に立ちました、心から有難うございました。コマンドボタンを入れ込みマウスで選択して入力データを選択する所まではなんとか行きましたので、次回はより使い易いコードになるようにしていきたいと思います。

補足

早速、質問への説明ありがとうございました。
良く理解する事が出来ました。
尚、マクロもご紹介下さいまして、誠にありがとうございました。なるほど、無駄のないスッキリしたコードで関心致しました。　効率良く、出力結果も見易くし出力する事が出来ました。
大変お手数がお掛けしますが、可能でしたら下記について教えて頂きたいです。
１）マクロで6行目以降の出力データをテーブル形式で表示させる事は可能でしょうか？
２）件数の総合計も表示させたいのですが可能でしょうか？
３）Excelを知らない素人でも実行出来るよう、このマクロをダブルクリックすると、入力データの在処を入力出来るように修正する事は可能でしょうか？

回答No.3

noname#258475

オタクな事をしなくても

戻り値の定義のFunctionを
'戻り値の定義
Function count_row(ByVal ws As Worksheet) As Long
count_row = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 2
End Function
にするか
データ総行数求め()の中の
cnt = count_row(wb.Worksheets("カテーログ"))
の部分を
With wb.Worksheets("カテーログ")
cnt = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
End With
に変更すればいいだけの話。

Worksheets("カテーログ").Range("A3").Value
は意味がない。

お礼

ご教示を頂きまして、ありがとうございました。参考になりました。

Powered by GRATICA

回答No.1

SI299792

動作確認はしていないのですが、ぱっと見気になったのは、
fpath = "C:\Users\Owner\Documents\連結作業\202304-202309\)"
の｢)｣ です。
これをfname と結合すると、
C:\Users\Owner\Documents\連結作業\202304-202309\)*.xlsx
になるので、
)*.xlsx
を探しに行きます。
｢)｣ で始まるファイルが無ければ、ファイルが無いので何もしません。
とりあえず直してやってみて下さい。それで問題があれば、補足に書いて下さい。

補足

ご教示ありがとうございました。単純な記載ミスをしておりました。『)』を削除して、マクロは動作しました。
ネットに掲載されていたマクロのコードをそのまま引用している為、総行数は１行目～最終行の数となってしまっています。
自分がやりたいことは、A列の３行目から最終行までの総行数を求める事です。このコードの何処をどのように修正したら３行目から最終行までをカウント出来るようになるのか、大変お手数ですが、ご教示頂けないでしょうか。
それから、このマクロの右記コード『For k = 1 To 256』の意味が分からずつかっております。総行数を求めるファイル数は100個程度なのですが、問題ないでしょうか？