エクセルの学校：全文検索：Hyper Estraier： cell filename

Results of 1 - 1 of about 295 for cell filename (0.001 sec.)

cell (1170), filename (1984)

[[20231018110055]]: #score: 11157; @digest: d86097be205297076497b69d41040648; @id: 95309; @mdate: 2023-10-20T03:18:13Z; @size: 8876; @type: text/plain; #keywords: datfile (71119), filename2 (33811), 弧内 (18832), 正フ (15602), 得fi (14225), 内文 (13494), regexp (12390), 字削 (8972), ーゲ (8207), 括弧 (7740), ゲッ (7153), filepath (6574), ル,* (5468), filename (5405), savechanges (4855), filefilter (4560), personal (3353), ファ (3269), getopenfilename (2929), output (2918), トフ (2895), ルパ (2740), vbscript (2666), global (2572), ァイ (2531), cell (2347), replace (2318), 終了 (2300), テキ (2130), イル (2119), pattern (2106), キス (1969); 『括弧内文字削除のマクロで質問』（まっつん）
テキストファイル内の括弧内の文字列（括弧も含んで）を削除して別名で保存するマクロを作成中です。下記マクロですが、問題があるのでアドバイスをお願いします。「'括弧内文字列削除(括弧も含む）」で書き出し自体は上手く処理されていますがファイル名相当のシートに書き出されるので「'新規に修正ファイルをテキストファイルに書き出す」では sheet1を対象にしているのでこのままでは上手く処理できないどのように整合すれば良いのか ? Columns("A").Selectを選択して処理していますが A列が5000行と大きいのが原因なのか? 処理時間がすごく必要で暫くハング状態になる。 Application.ScreenUpdating = False を入れてみましたが目に見えた効果がありません。 Option Explicit Sub 括弧内文字削除() ' 'ダイアログでターゲットファイル（txt)を選択（読み込み) --------------- Dim FileName As Variant Dim FileName2 As String Dim FilePath As String Dim fso As New FileSystemObject FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.txt") If FileName = False Then Exit Sub End If 'ターゲットファイルの拡張子無しのファイル名を取得 FileName2 = fso.GetBaseName(FileName) 'ターゲットファイルのパス取得 FilePath = Replace(FileName, Dir(FileName), "") Workbooks.Open FileName '括弧内文字列削除(括弧も含む）-------------------------------- Dim RegExp As Object Dim Cell As Range ' Set RegExp = CreateObject("VBScript.RegExp") RegExp.Global = True RegExp.Pattern = "[（(].*[)）]" ' Application.ScreenUpdating = False Columns("A").Select For Each Cell In Selection Cell = RegExp.Replace(Cell, "") Next '新規に修正ファイルをテキストファイルに書き出す ------------- Dim ws As Worksheet Set ws = Worksheets("Sheet1") Dim datFile As String datFile = FilePath & FileName2 & "_mod.txt" Open datFile For Output As #1 Dim i As Long Stop For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Print #1, ws.Cells(i, "A").Value Next Close #1 Application.ScreenUpdating = True MsgBox datFile & "に書き出しました" End Sub ＜使用 Excel:Excel2021、使用 OS:Windows11 ＞ ---- 自己レスです。シートの名前の整合は、Set ws = Worksheets(FileName2) で良さそうです。後は、高速化が残っています。（まっつん） 2023/10/18(水) 11:29:18 ---- Columns("A").Select For Each Cell In Selection Cell = RegExp.Replace(Cell, "") Next これだと、A列の最終行の A1048576セルまで、たとえ空白でも置換を実行します書き出すときに、 For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Print #1, ws.Cells(i, "A").Value Next としているように、データが入っている最終行までを処理の対象にすべきです。また、1セル毎に値を書き換えていると、かなり時間が掛かります。以下のようにすると結構早くなると思います。 Sub sample() Set RegExp = CreateObject("VBScript.RegExp") RegExp.Global = True RegExp.Pattern = "[（(].*[)）]" Dim buf With Range("A1", Cells(Rows.Count, "A").End(xlUp)) buf = .Value For i = 1 To UBound(buf) buf(i, 1) = RegExp.Replace(buf(i, 1), "") Next .Value = buf End With End Sub （´・ω・`） 2023/10/18(水) 11:53:02 ---- 選択範囲がA列で巨大すぎたのが原因だったようなので範囲を特定するように下記に変更しました。 Range(Cells(1, 1), Cells(tr, 1)).Select これで十分高速化したので満足ですが何かコードで変更すべき点があればアドバイスお願いします。と書いて投稿しようとしたら´・ω・`さんからアドバイスがありました。ありがとうございます。ご指摘の点、コードに反映したいと思います。現時点では。シートが2個（テキストファイル名、xlsm名）が出来てしまうのが気になります。 Option Explicit Sub 括弧内文字削除() ' 'ダイアログでターゲットファイル（txt)を選択（読み込み) --------------- Dim FileName As Variant Dim FileName2 As String Dim FilePath As String Dim fso As New FileSystemObject FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.txt") If FileName = False Then Exit Sub End If 'ターゲットファイルの拡張子無しのファイル名を取得 FileName2 = fso.GetBaseName(FileName) 'ターゲットファイルのパス取得 FilePath = Replace(FileName, Dir(FileName), "") Workbooks.Open FileName '括弧内文字列削除(括弧も含む）-------------------------------- Dim RegExp As Object Dim Cell As Range Dim tr As Long ' tr = Cells(Rows.Count, "A").End(xlUp).Row Set RegExp = CreateObject("VBScript.RegExp") RegExp.Global = True RegExp.Pattern = "[（(].*[)）]" ' Application.ScreenUpdating = False Range(Cells(1, 1), Cells(tr, 1)).Select For Each Cell In Selection Cell = RegExp.Replace(Cell, "") Next '新規に修正ファイルをテキストファイルに書き出す ------------- Dim ws As Worksheet Set ws = Worksheets(FileName2) Dim datFile As String datFile = FilePath & FileName2 & "_mod.txt" Open datFile For Output As #1 Dim i As Long For i = 1 To tr Print #1, ws.Cells(i, "A").Value Next Close #1 Application.ScreenUpdating = True MsgBox datFile & "に書き出しました" End Sub （まっつん） 2023/10/18(水) 12:01:41 ---- ＞＞現時点では。＞＞シートが2個（テキストファイル名、xlsm名）が出来てしまうのが気になります。最後のように書き換えてみましたが MsgBox datFile & "に書き出しました" & vbCrLf & _ "処理が終了したのでEXCELを閉じて終了です。" ThisWorkbook.Close SaveChanges:=False End Sub マクロが終了しても最初に読み込んだファイル名（FileName）のシートが残ってEXCELが終了しません。 FileName = Application.GetOpenFilename マクロが終了したらきれいにEXCELも終了する方法はありませんか ? （まっつん） 2023/10/18(水) 15:16:39 ---- 以下に変更しました。 MsgBox datFile & "に書き出しました" & vbCrLf & _ "処理が終了したのでEXCELを閉じて終了です。" ActiveWorkbook.Close SaveChanges:=False ThisWorkbook.Close SaveChanges:=False Application.Quit これでもVBAを見るとPERSONAL_XLSBがあるのでアドインが起動しているようでワークシートは無い真っ黒の状態が表示されています。 PERSONAL_XLSBを含めて EXCELを終了させる方法はありませんか ? （まっつん） 2023/10/18(水) 16:10:22 ---- 自己解決しました。以下参考にして https://www.excel.studio-kazu.jp/kw/20040414114513.html 順番を変更してEXCELが終了しました。 MsgBox datFile & "に書き出しました" & vbCrLf & _ "処理が終了したのでEXCELを閉じて終了です。" '// Excelを終了する Application.Quit ActiveWorkbook.Close SaveChanges:=False ThisWorkbook.Close SaveChanges:=False （まっつん） 2023/10/18(水) 16:40:17 ---- 興味本位で聞きますが、テキストファイルの文字コードは、それぞれ何になるのでしょうか? （もこな2 ） 2023/10/20(金) 08:49:44 ---- もう見ていないかもですが追加で何点か。 ■1 ↓は何を目的としていますか? Workbooks.Open FileName 最終的に↓で1行ずつ書き出していますから、そもそもブックとして開く（シート上に展開する）必要はないように思います。 Open datFile For Output As #1 したがって、例えば↓のようなことでも期待する結果になると思います。 Sub 研究用1() Dim ファイルパス As String, tmp As String Dim FF1 As Long, FF2 As Long Dim RegExp As Object FF1 = FreeFile ファイルパス = Application.GetOpenFilename(FileFilter:="テキストファイル,*.txt") If ファイルパス = "False" Then Exit Sub Open ファイルパス For Input As #FF1 FF2 = FreeFile Open Left(ファイルパス, Len(ファイルパス) - 4) & "_mod.txt" For Output As #FF2 Set RegExp = CreateObject("VBScript.RegExp") RegExp.Global = True RegExp.Pattern = "[（(].*[)）]" Do Until EOF(1) Line Input #FF1, tmp Print #FF2, RegExp.Replace(tmp, "") Loop Close #FF1 Close #FF2 End Sub ■2 また、シート上に展開するならばそれはそれで、1セルずつ処理するのではなくReplaceメソッドで一括処理すれば、さほど時間はかからないように思います。 ■3 ＞〜PERSONAL_XLSBがあるので〜ブックとして開くにせよ、自ブックのシート上に展開（インポート）するにせよ、そのブックのSavedをTrueにしてから、ExcelをQuitすればよいと思います。（テキストファイルを出力したら用なしですよね?）（もこな2 ） 2023/10/20(金) 12:18:13 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202310/20231018110055.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ