エクセルの学校：全文検索：Hyper Estraier：（Mook）

Results of 1 - 1 of about 1215 for （Mook） (0.001 sec.)

[[20150312153202]]: #score: 9211; @digest: f3ea7b171b52b5f475f240a102947a31; @id: 67485; @mdate: 2015-03-13T00:38:26Z; @size: 7686; @type: text/plain; #keywords: 知_ (43608), 県リ (42335), 庫_ (35949), houpath (29993), zippath (29958), 縮¥" (22494), ekaku (22494), 20150310 (22494), katanohosi (19497), strworkbookname (18278), 三河 (16399), 島", (16322), sikaku (15880), 島| (14961), 山" (13347), ken (12913), 姫路 (12758), 縮フ (11493), 山| (11111), 山", (10845), 兵庫 (10170), 県名 (9695), リネ (8823), 圧縮 (8271), ダ= (8012), 福井 (7339), 愛知 (7186), 富山 (6951), 滋賀 (6421), 佐賀 (6303), 長崎 (5961), 岐阜 (5724); 『VBAでのBOOKのリネームについて』（katanohosi）
日付+県名+件数.xlsxが最大で32県、その日によってはばらつきがあります。このBOOK名を県名.xlsxにしたく下記を作成したのですが、存在しない県名のBOOKがあるとエラーで止まります。流れを追うと、該当がないときはそのまま ActiveWorkbook.SaveAs Filename:=Zippath & ken(i) & Ekaku ActiveWorkbook.Close を実行しようとするからみたいです。該当がない場合はスルーさせたいのですが、どなたか教えてください。よろしくお願いいたします。 Sub リネーム() Dim apath As Variant Dim Houpath As Variant Dim Zippath As Variant Dim myFile As Variant Dim strWorkBookName As Variant Dim sikaku As Variant Dim Ekaku As Variant Dim ken(32) As Variant '変数kenは整数型宣言1から32まで宣言するので、最後の数字を入れればOK Dim i As Integer Dim siteibi As Variant Dim ken As Variant ken(1) = "大阪" ken(2) = "和歌山" ken(3) = "京都" ken(4) = "滋賀" ken(5) = "奈良" ken(6) = "兵庫_神戸" ken(7) = "兵庫_姫路" ken(8) = "愛知_名古屋" ken(9) = "愛知_三河" ken(10) = "岐阜" ken(11) = "三重" ken(12) = "静岡" ken(13) = "石川" ken(14) = "富山" ken(15) = "福井" ken(16) = "広島" ken(17) = "島根" ken(18) = "岡山" ken(19) = "鳥取" ken(20) = "山口" ken(21) = "愛媛" ken(22) = "香川" ken(23) = "徳島" ken(24) = "高知" ken(25) = "福岡" ken(26) = "佐賀" ken(27) = "長崎" ken(28) = "熊本" ken(29) = "大分" ken(30) = "鹿児島" ken(31) = "宮崎" ken(32) = "沖縄" apath = ThisWorkbook.Path Houpath = apath & "¥20150310¥" Zippath = apath & "¥圧縮¥" sikaku = ".XLSX" Ekaku = ".xlsx" siteibi = ThisWorkbook.Sheets(1).Range("AN33") ken = "*" & ken(i) & "*" Application.ScreenUpdating = False ChDir ThisWorkbook.Path For i = 1 To 32 With CreateObject("Scripting.FileSystemObject").Getfolder(Houpath) For Each myFile In .Files If myFile.Name Like "*" & ken(i) & "*" & sikaku Then With Workbooks.Open(Filename:=myFile.Path, Password:="1234") strWorkBookName = ActiveWorkbook.Name '今開いたファイルの名前を取得 "*●●*.xlsx" End With Exit For End If Next myFile End With ActiveWorkbook.SaveAs Filename:=Zippath & ken(i) & Ekaku ActiveWorkbook.Close Next End Sub ＜使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- 自分で書いたコードなのかな? 1行1行何をやっているか理解すれば解かると思いますよ。もう少し頑張ってみては。 BJ ---- BJさんのご意見を尊重して・・・一言だけせっかくIfで条件判定しているのだから、その処理も加えてみたらどうでしょうか? というか、総当たりの順番逆じゃない? （稲葉） 2015/03/12(木) 15:58 (katanohosi) BJさん稲葉さんありがとうございます!! 初心者から脱せず頭が煮えきってました。冷静に考えたら下記のように修正すればOKでした。もっと冷静に考えるべきでした; ところで、稲葉さんの「総当たりの順番逆じゃない?」はどこの部分になりますでしょうか。すみません、教えていただければありがたいです。 Application.ScreenUpdating = False ChDir ThisWorkbook.Path For i = 1 To 32 With CreateObject("Scripting.FileSystemObject").Getfolder(Houpath) For Each myFile In .Files If myFile.Name Like "*" & ken(i) & "*" & sikaku Then With Workbooks.Open(Filename:=myFile.Path, Password:="1234") strWorkBookName = ActiveWorkbook.Name '今開いたファイルの名前を取得 "*●●*.xlsx" ActiveWorkbook.SaveAs Filename:=Zippath & ken(i) & Ekaku ActiveWorkbook.Close End With Exit For End If Next myFile End With Next MsgBox "リネームが終了しました。圧縮してください。" ---- ちょっと書いている間に、だいぶ話が進んでいるようですが、せっかく書いたので、参考までの修正案です。 Sub リネーム() Dim 県リスト県リスト = Array( _ "大阪", "和歌山", "京都", "滋賀", "奈良", "兵庫_神戸", "兵庫_姫路", "愛知_名古屋", "愛知_三河", "岐阜", _ "三重", "静岡", "石川", "富山", "福井", "広島", "島根", "岡山", "鳥取", "山口", _ "愛媛", "香川", "徳島", "高知", "福岡", "佐賀", "長崎", "熊本", "大分", "鹿児島", _ "宮崎", "沖縄") Dim データフォルダデータフォルダ = ThisWorkbook.Path & "¥20150310" Dim 圧縮フォルダ圧縮フォルダ = ThisWorkbook.Path & "¥圧縮¥" Application.ScreenUpdating = False Dim ファイル Dim 県名 For Each ファイル In CreateObject("Scripting.FileSystemObject").Getfolder(データフォルダ).Files For Each 県名 In 県リスト If ファイル.Name Like "*" & 県名 & "*.xlsx" Then With Workbooks.Open(Filename:=ファイル.Path, Password:="1234") .SaveAs Filename:=圧縮フォルダ & 県名 & ".xlsx" .Close End With Exit For End If Next Next Application.ScreenUpdating = True End Sub （Mook） 2015/03/12(木) 16:39 ---- Mookさんありがとうございます。リストを配列で作成するとこんなにスッキリするんですね。こんな上級な方法があるんですね。凄いです! それから、変数など日本語で書くと他の人にも凄くわかりやすいですね。早速使わせていただきます。まだまだネットで調べてつぎはぎをやっているので、いろいろなパターンを知ることができるとすごくありがたいです。（katanohosi） 2015/03/12(木) 16:46 ---- 総当たりの順番ですが、Mookさんの修正案に丸ごと入ってます。県名の配列の中で、ブック名を回すのではなくブック名の中で、県名の配列を回すほうが後から見たときわかりやすいかなと。（稲葉） 2015/03/12(木) 16:49 ---- 稲葉さんコメントありがとうございます。もっとスキルが上がるよう頑張ります。（katanohosi） 2015/03/12(木) 17:14 ---- 前似たようなもの作った記憶があって掘り出したので、参考出品比較しやすいように、Mookさんの変数名に合わせてあります。 Sub リネーム2() Dim 県リスト As String Dim データフォルダ Dim 圧縮フォルダ Dim ファイル県リスト = "大阪|和歌山|京都|滋賀|奈良|兵庫_神戸|兵庫_姫路|愛知_名古屋|愛知_三河|岐阜|" & _ "三重|静岡|石川|富山|福井|広島|島根|岡山|鳥取|山口|愛媛|香川|徳島|高知|福岡|" & _ "佐賀|長崎|熊本|大分|鹿児島|宮崎|沖縄" データフォルダ = ThisWorkbook.Path & "¥20150310" With CreateObject("VBScript.RegExp") .Pattern = "(" & 県リスト & ")" For Each ファイル In CreateObject("Scripting.FileSystemObject").Getfolder(データフォルダ).Files If .Text(ファイル.Name) Then ブックの保存ファイル.Path, .Execute(ファイル.Name)(0) Exit For End If Next ファイル End With End Sub Private Sub ブックの保存(ByVal ファイルパス As String, ByVal 県名 As String) Application.ScreenUpdating = False With Workbooks.Open(Filename:=ファイルパス, Password:="1234") .SaveAs Filename:=ThisWorkbook.Path & "¥圧縮¥" & 県名 & ".xlsx" .Close End With End Sub （稲葉） 2015/03/12(木) 17:16 ---- 稲葉さんありがとうございます。上級の方々が作ると似たようであっても、違う作りができるんですね。初めて見る記載があって「With CreateObject("VBScript.RegExp")」今ネットでいろいろ検索しています。本当に勉強になります。これが解るまで少し時間がかかりそうです; 確認不足で質問して恥ずかしかったですが、新しいことを知ることができて良かったと思っています。ありがとうございました。（katanohosi） 2015/03/13(金) 09:38 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/201503/20150312153202.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ