人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です
c:\test\のホルダーに複数のtxtファイルがあります
ファイルの中の行数(件数)を数えてファイルの最後に
その数を記入するマクロはできますか

AAAA.txt
ファイル名の最後に
AAAA_12345.txt
と数字の前にアンダーバーを入れて数字を記入する
複数のファイルは順番に連続して数えて記入する
データは1行目からです列は複数あります
よろしくお願いします

●質問者: inosisi
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● oil999
●80ポイント ベストアンサー

Excelのマクロでよければ、下記をお試しください。
なお、Windows環境なので、改行はCR+LFを1行として数えます。

Option Explicit

'拡張子を除く
Function GetFNameFromFStr(sFileName As String) As String
 Dim sFileStr As String
 Dim lFindPoint As Long
 Dim lStrLen As Long
 
  '文字列の右端から"."を検索し、左端からの位置を取得する
 lFindPoint = InStrRev(sFileName, ".")
 
  '拡張子を除いたファイル名の取得
 sFileStr = Left(sFileName, lFindPoint - 1)

 GetFNameFromFStr = sFileStr
End Function

'1ファイル処理
Function countLine(path As String, fname As String) As Long
 Dim buf As String
 Dim cnt As Long
 Dim dc As Object
 
 Set dc = CreateObject("Scripting.Dictionary")
  '行数カウント
 cnt = 0
 Open path & fname For Input As #1
 Do Until EOF(1)
 Line Input #1, buf
 cnt = cnt + 1
 Loop
 Close #1
 countLine = cnt
End Function

'ファイル探索+ファイル名変更
Sub hogeConv(path As String, ext As String)
 Dim fcol As Object, re As Object
 Dim flist As Variant, remat As Variant
 Dim pat As String, fname As String
 Dim n As Long
 
  '処理対象ファイル探索+処理実行
 Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).Files
 Set re = CreateObject("VBScript.RegExp")
 pat = "\." & ext & "$"
 With re
 .Pattern = pat
 .IgnoreCase = True
 .Global = True
 For Each flist In fcol
 fname = GetFNameFromFStr(flist.name)
 Set remat = .Execute(flist.name)
 If remat.Count > 0 Then
 n = countLine(path, flist.name)
 Name path & fname & "." & ext As path & fname & "_" & n & "." & ext
 End If
 Next flist
 End With
 Set re = Nothing
 Set fcol = Nothing
End Sub

Sub main()
 Call hogeConv("C:/test/", "txt")
End Sub


inosisiさんのコメント
ありがとうございます うまくいきました 助かります

inosisiさんのコメント
すみませんが_アンダーバーが不要の場合のマクロを修正方法を教えていただき滝野ですが よろしくお願いします

inosisiさんのコメント
Name path & fname & "." & ext As path & fname & "_" & n & "." & ext 記述の"_"の_アンダーバーを取って""のみにしたらうまくいきました

oil999さんのコメント
56行目を以下のように変更してください。 >|vb| Name path & fname & "." & ext As path & fname & n & "." & ext ||<

inosisiさんのコメント
ありがとうございました 完璧です

2 ● Silvanus
●20ポイント

もし、処理ファイル数が1万個を超える様であれば
lngNFMaxの値を増やして下さい。

Option Base 0
Option Explicit

Sub Inoshishi1352458121()

Const lngNFMax As Long = 10000
Const strPath As String = "C:\test\"

Dim strFNList(1, lngNFMax) As String
Dim strFN As String
Dim lngCnt1 As Long
Dim lngCnt2 As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

lngCnt1 = 0
strFN = Dir(strPath & "*.txt", vbNormal)

 Do While strFN <> ""
 Workbooks.Open Filename:=strPath & strFN, Format:=5
 strFNList(0, lngCnt1) = strFN
 strFNList(1, lngCnt1) = _
 Left(strFN, Len(strFN) - 4) & "_" & _
 ActiveSheet.Cells.SpecialCells(xlLastCell).Row _
 & ".txt"
 Application.DisplayAlerts = False
 ActiveWorkbook.Close SaveChanges:=False
 Application.DisplayAlerts = True
 lngCnt1 = lngCnt1 + 1
 strFN = Dir
 Loop
 For lngCnt2 = 0 To lngCnt1 - 1
 Name strPath & strFNList(0, lngCnt2) As _
 strPath & strFNList(1, lngCnt2)
 Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

inosisiさんのコメント
ありがとうございます 結果が数字の1しか入らないですが 何が原因でしょうか

inosisiさんのコメント
ちなみにtxtはタブ切のtxtです

inosisiさんのコメント
すみませんが_アンダーバーが不要の場合のマクロを修正方法を教えていただき滝野ですが よろしくお願いします

Silvanusさんのコメント
Left(strFN, Len(strFN) - 4) & "_" & _ とある行を Left(strFN, Len(strFN) - 4) & _ としてみて下さい。

Silvanusさんのコメント
あ、すみません。上の方のコメを見落としていました…orz。 Workbooks.Open Filename:=strPath & strFN, Format:=5 の行を Workbooks.Open Filename:=strPath & strFN, Format:=1 にしてみて下さい。上手く行くと良いのですが…。

inosisiさんのコメント
ありがとうございます やはり1となってしまいます アンダーバーは修正できました すみません一旦終了させていただきます 原因がわかりましたら教えてください

Silvanusさんのコメント
すみません…orz。こちらでは上手く行っているのですが…。 お役に立てませず誠に申し訳ございません。 原因が判りましたらコメント入れます。

Silvanusさんのコメント
スミマセン。不躾ながら逆質問させていただいて宜しいでしょうか。私の マクロは、対象となるテキストファイルを一旦ワークシートに読み込んで、 読み込まれた内容の最下セル行を検出する方法で行数をカウントしています。 お手数ですが、「1」とカウントされてしまう対象ファイル(全て!?、汗)の 内のどれでも1つで構いませんので、Excelの「ファイルを開く」メニューから タブ区切りテキストとして読み込んでみていただけないでしょうか? (恐らく9分9厘間違いないでしょうが)ワークシートの読み込まれた結果が 件数=行数となっているかどうかご確認いただきたく存じます。

Silvanusさんのコメント
こちらでは動いてるんですが…(涙)。最後にひとつだけ。 ActiveSheet.Cells.SpecialCells(xlLastCell).Row _ を ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row _ に変えてみていただいて、上手く行かない様であれば降参します…。 誠にスミマセン…orz。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ