Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150404000731]]
- #score: 9211
- @digest: 4b0524d8b2291bd09a6b6841e2a6c0a6
- @id: 67692
- @mdate: 2015-04-05T12:39:38Z
- @size: 10459
- @type: text/plain
- #keywords: dropscriptpath (64439), listfilepath (61313), shortcutpath (51665), writeline (36921), nextscheduletime (30483), cleanupheader (29523), scriptname (27462), listname (23246), cleanupheaderconstructor (22494), arguments (11138), wscript (5679), opentextfile (5286), ドロ (4599), specialfolders (4234), リプ (3948), fso (3206), プト (2981), ファ (2725), path (2511), 数選 (2492), ロッ (2408), デス (2369), filesystemobject (2255), スク (2111), ァイ (2110), ルフ (2016), ヘッ (1992), トッ (1950), ップ (1920), thisworkbook (1919), ッダ (1796), イル (1766)
- 『複数エクセルファイルの自動置換マクロ』（まこ）
ヘッダにある 、 だけを取り除きたいです。 ひとつのエクセルファイルごとに行選択して置換でできますが、無数のファイルがあるとき困ってしまいます。 例えばエクセルファイルをドラッグしてあるソフトに入れれば、自動で上記のことができて吐きだされるというものはマクロでできるのでしょうか。 もしくはエクセルファイルを複数選択してあるソフトへドラッグしたら自動置換されてはきだれるというようなものです。よろしくお願いいたします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- エクセルファイルにあるヘッダーとは、そのブックのどのシートのどこにあるのでしょうか? ドラッグして、ほうり込むというイメージは、たとえばエクスプローラ上で複数のブックを選択してOKボタンを押すといったことでもよろしいですか? 吐き出されるというのは、自動置き換え後、保存されるということでいいですか? （β） 2015/04/04(土) 08:27 ---- もし、各エクセルファイルの一行目だけ削除したいというのなら次のマクロはどうでしょう? Sub aaa() Dim a As Long Dim Path As String Dim u As String Dim b As Long a = 1 Path = "エクセルファイルが入っているフォルダのパス名+¥" '記入例 C:¥Users¥ユーザー名¥Documents¥aba¥ u = Dir(Path & "*.xlsx") Do Until u = "" Cells(a, 1).Value = u u = Dir() a = a + 1 Loop b = a a = 1 Do Until a = b Workbooks.Open Path & Cells(a, 1).Value Workbooks(Cells(a, 1).Value).Sheets(1).Rows("1:1").Delete Shift:=xlUp Workbooks(Cells(a, 1).Value).Save Workbooks(Cells(a, 1).Value).Close a = a + 1 Loop End Sub （スズメ） 2015/04/04(土) 10:21 ---- To スズメさん おそらく、どこかのセルにある先頭の 、 だけを消去したいんだと思います。 現在手作業で【置換】で処理しておられるのですから。 それはともあれ。 '記入例 C:¥Users¥ユーザー名¥Documents¥aba¥ ユーザー名をハードコーディングすると、他のPCで実行した時に動かなくなります。 これらパスは、動的に取得することが必要です。以下、参考コードです。 Sub Sample1() Dim path As String path = CreateObject("WScript.Shell").Specialfolders("DeskTop") MsgBox path path = CreateObject("WScript.Shell").Specialfolders("myDocuments") MsgBox path path = Environ("USERPROFILE") MsgBox path End Sub また、後半のループ、これは For/Next で書くべきところですね。 というか、前半で処理してしまえば、後半は不要ですけどね。 （β） 2015/04/04(土) 10:36 ---- マクロ内で表示されるファイル選択ダイアログ上で、処理したいブックを複数選択し、OKを押せば実行します。 とりあえず、選択されたブックの最初のシートの1行目にある "、" を消去しています。 場所は、そこではなく、ここ とか、たとえば、各セルの先頭にあるものだけ 等々 要件については 言ってもらえれば対応します。 Sub Test() Dim fList As Variant Dim fName As Variant Dim bk As Workbook '処理したいブックの選択。複数選択可能。 fList = Application.GetOpenFilename(FileFilter:="対象ブック,*.xls*", MultiSelect:=True) If Not IsArray(fList) Then Exit Sub 'キャンセルボタン Application.ScreenUpdating = False For Each fName In fList Set bk = Workbooks.Open(fName) bk.Sheets(1).UsedRange.Rows(1).Replace What:="、", Replacement:="", LookAt:=xlPart bk.Close True Next MsgBox "クリーニング、完了です" End Sub （β） 2015/04/04(土) 11:13 ---- ドロップしたいというところに反応して、お遊びのコードです。 新規ファイルに下記のマクロを置き、適当な名前を付けてマクロブックとして保存して 閉じます。 もう一度このファイルを開くと、ファイルと同じフォルダに、 「ここにファイルをドロップしてください.vbs」 というファイルができるので、ここに処理をしたい EXCEL ファイルをドロップします。 ヘッダ内（各シートの1行目）の「、」が削除されます。 このマクロファイルを閉じると「ここにファイルをドロップしてください.vbs」も消えます。 マクロの設定 EXCEL から Alt+F11 で開いたウィンドウで、 ツール ⇒ 参照設定 Microsoft Scripting Runtime にチェックします。 ThisWorkbook の下に 「（1）ThisWorkbook モジュール」のコードを 挿入⇒標準モジュール で開いたウィンドウに 「（2）標準モジュール」のコードを置きます。 （1）ThisWorkbook モジュール ---------------------- Private Sub Workbook_Open() CleanupHeaderConstructor End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) CleanupHeaderDestructor End Sub ---------------------- （2）標準モジュール ---------------------- Option Explicit Const ScriptName = "ここにファイルをドロップしてください.vbs" Const ListName = "CleanupHeaderList.txt" Public NextScheduleTime '//----------------------------- Sub CleanupHeaderConstructor() '//----------------------------- Dim fso As New Scripting.FileSystemObject Dim dropScriptPath dropScriptPath = ThisWorkbook.Path & "¥" & ScriptName '// スクリプトの作成 Dim ListFilePath ListFilePath = ThisWorkbook.Path & "¥" & ListName With fso.CreateTextFile(dropScriptPath, True) .WriteLine "Dim fso" .WriteLine "Set fso = CreateObject(""Scripting.FileSystemObject"")" .WriteLine "If WScript.Arguments.Count = 0 Then WScript.Quit" .WriteLine "With fso.OpenTextFile(""" & ListFilePath & """, 8, True )" .WriteLine " For i=0 To WScript.Arguments.Count - 1" .WriteLine " .WriteLine WScript.Arguments(i)" .WriteLine " Next" .WriteLine " .Close" .WriteLine "End With" .Close End With Dim wsh Set wsh = CreateObject("WScript.Shell") '// デスクトップショートカットの作成 Dim ShortCutPath ShortCutPath = wsh.SpecialFolders("Desktop") & "¥" & Replace(ScriptName, ".vbs", ".lnk") With wsh.CreateShortcut(ShortCutPath) .TargetPath = dropScriptPath .IconLocation = "shell32.dll,43" .Save End With '// スケジュールの設定 With ThisWorkbook.Worksheets(1) .Range("A1:B1") = Array("実行時間", "処理ファイル") .Columns("A").NumberFormatLocal = "YYYY/MM/DD hh:mm:ss" .Columns("A").ColumnWidth = 20 End With CleanupHeader End Sub '//----------------------------- Sub CleanupHeaderDestructor() '//----------------------------- Dim fso As New Scripting.FileSystemObject '// スクリプトの削除 Dim dropScriptPath dropScriptPath = ThisWorkbook.Path & "¥" & ScriptName If fso.FileExists(dropScriptPath) Then fso.DeleteFile dropScriptPath Dim wsh Set wsh = CreateObject("WScript.Shell") '// デスクトップショートカットの削除 Dim ShortCutPath ShortCutPath = wsh.SpecialFolders("Desktop") & "¥" & Replace(ScriptName, ".vbs", ".lnk") If fso.FileExists(ShortCutPath) Then fso.DeleteFile ShortCutPath '// スケジュールの解除 On Error Resume Next Application.OnTime NextScheduleTime, "CleanupHeader", , False End Sub '//----------------------------- Sub CleanupHeader() '//----------------------------- Dim fso As New Scripting.FileSystemObject Dim ListFilePath ListFilePath = ThisWorkbook.Path & "¥" & ListName Dim fl Dim f Dim ff Dim ws As Worksheet If fso.FileExists(ListFilePath) = True Then fl = Split(fso.OpenTextFile(ListFilePath).ReadAll(), vbNewLine) fso.DeleteFile ListFilePath For Each f In fl '// ドロップされたのがフォルダだったら、中のフォルダとファイルをリストに追記 If fso.FolderExists(f) Then With fso.OpenTextFile(ListFilePath, 8, True) For Each ff In fso.GetFolder(f).SubFolders .WriteLine ff.Path Next For Each ff In fso.GetFolder(f).Files .WriteLine ff.Path Next .Close End With End If '// ドロップされたのが EXCEL ファイルだったら全シートを処理 If InStr(LCase(fso.GetExtensionName(f)), "xls") > 0 Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False With Workbooks.Open(f) For Each ws In .Worksheets ws.Rows(1).Replace What:="、", Replacement:="", LookAt:=xlPart '// 置換処理 Next .Save .Close End With '// 先頭シートに実行履歴を記録 With ThisWorkbook.Worksheets(1) Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 2) = Array(Now(), f) End With Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End If Next End If NextScheduleTime = Now + TimeValue("00:00:05") Application.OnTime NextScheduleTime, "CleanupHeader" End Sub ---------------------- （Mook） 2015/04/04(土) 11:30 ---- To Mookさん わぁ、おもしろいですね! 勉強になりますし、今後、この手法、パクらせてもらうかもです。 同時にデスクトップにショートカットを作り出して、そこにドロップしてもらうのもいいかもしれませんね。 ところで、Sub CleanupHeaderConstructor() の With fso.CreateTextFile(dropScriptPath) この End With の前に .Close が抜けてませんか? （β） 2015/04/05(日) 07:05 ---- 確かにお行儀悪いかもしれませんが、プロシージャやスクリプト終了時にフラッシュ されると（勝手に）信じているので、単一ファイルの処理では省略して使ってますが、 ここはお行儀よく .Close しておいた方が良いですね。 修正しました。 （ダブルで抜けていました。） ファイルはデスクトップに出す方がアイデアとしては面白いですね。 アイコンを変えたり、フォルダをドロップしたら下を検索したりと、 改善の余地は多々あると思います。 （Mook） 2015/04/05(日) 10:10 ---- 自分のコメントに、自分で対応w。 以下、変更点です。 ・デスクトップにアイコンを表示（★アイコン） ・フォルダをドロップすると、フォルダ以下のファイルを処理 ・処理した時間とファイルの履歴を先頭シートに表示 に対応したコードに差し替えました。 （Mook） 2015/04/05(日) 20:58 （Mook） 2015/04/05(日) 21:38 追加修正... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201504/20150404000731.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97014 documents and 608133 words.
訪問者：