Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
322 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【75987】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 17:39 -
引用なし
パスワード
   ▼daisuke さん：

>先頭とは限らないのです。

>◎◎から出荷　M 予定
>◎◎待ち　M
>M
>M取り扱い中止
>などなど
>
>品目だけ記号（記号はA〜GZですがもっと増えていきそうです）でその部分だけ
>を変換し変換した文字のみを色を付けたいのです。

疑似コードで書くと

>　　'---- シート２
>　　With Worksheets(2)
>　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
>　　End With
>　　For Each c In r
　　あるセルの文字列について
　　　　Loopで 記号 A〜GZがあるか？ InStr関数で調べる
　　　　　もしInStr関数が >0 を返したら、
　　　　　　 その位置から 置換文字列で置換する。
　　　　　　 さらに 置換文字列の長さだけFont色を変える
　　　　　End If
　　　　Loopおわり
　　Next c

こうすればよいのでは？
・ツリー全体表示
【75986】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 17:00 -
引用なし
パスワード
   こんにちは。　　#　外出から戻りました。

>いままで手作業で置換していましたがマクロで効率化したいです。
とのこと。

>M ××　→　みかん　××　部分一致で置換したいのです。
そのケースに関して、どのような手作業をやっていたのか、
回答願います。

日本語で説明したうえで、
マクロ記録のコードをアップしてください。
・ツリー全体表示
【75985】Re:A列B列シートの文字をみて別シートの...
質問  daisuke  - 14/8/15(金) 15:37 -
引用なし
パスワード
   ▼kanabun さん：
ありがとうございます。
先頭とは限らないのです。
せっかく考えてくださったのに私の説明が悪く申し訳ありません。
現状こんな感じです。
セル内（書式文字列）の文字がバラバラに入力されています。
◎◎から出荷　M 予定
◎◎待ち　M
M
M取り扱い中止
などなど

品目だけ記号（記号はA〜GZですがもっと増えていきそうです）でその部分だけ
を変換し変換した文字のみを色を付けたいのです。
お盆の時に申し訳ありません。急ぎませんがなにとぞよろしくお願いします。
・ツリー全体表示
【75984】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 14:52 -
引用なし
パスワード
   ▼daisuke さん：
>お答えありがとうございます。
>うまくいきましたが完全一致のみなのでしょうか
>シート２のセル内には M 予定　など文字が入っています。
>M ××　→　みかん　××　部分一致で置換したいのです。
>ちなみにセルの書式は文字列です。
>何度もすいません。
>よろしくお願いすいます。

じゃ、セルの「最初の一文字が」Mとかだったら、
と考えればいいのでは？

Sub Try2b()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range, c As Range
　　Dim s As String '◆追加
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　For Each c In r
　　　　s = Left$(c.Value, 1)　 '先頭一文字が
　　　　If dic.Exists(s) Then　 '辞書にあったら値に置換
　　　　　　c.Value = dic(s)
　　　　　　c.Font.Color = vbRed
　　　　End If
　　Next
End Sub
・ツリー全体表示
【75983】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 13:10 -
引用なし
パスワード
   ▼γ さん
回答ありがとうございます。

記憶では項目を全て書かなくてはいけないく、

考えてくださり本当にすいません。
・ツリー全体表示
【75982】Re:A列B列シートの文字をみて別シートの...
お礼  daisuke  - 14/8/15(金) 13:03 -
引用なし
パスワード
   お答えありがとうございます。
うまくいきましたが完全一致のみなのでしょうか
シート２のセル内には M 予定　など文字が入っています。
M ××　→　みかん　××　部分一致で置換したいのです。
ちなみにセルの書式は文字列です。
何度もすいません。
よろしくお願いすいます。
・ツリー全体表示
【75981】Re:A列B列シートの文字をみて別シートの...
発言  γ  - 14/8/15(金) 8:31 -
引用なし
パスワード
   横から失礼します。

C列に限定した、書式を指定した置換の動作をマクロ記録するとこうなります。
Sub Macro1()
　　Columns("C:C").Select
　　With Application.ReplaceFormat.Font
　　　　.Subscript = False
　　　　.Color = 255
　　　　.TintAndShade = 0
　　End With
　　Selection.Replace What:="R", Replacement:="りんご", LookAt:=xlWhole, _
　　　　SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
　　　　ReplaceFormat:=True
End Sub

あとは、Sheet1の置換組み合わせについて、繰り返しをすればよい、
ことになります。
例えば、こんな風です。
Sub test()
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Dim r　 As Range

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")

　　Application.ReplaceFormat.Font.Color = 255　'置換後のフォント色を赤に設定

　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　ws2.Columns("C").Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, _
　　　　　　 LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
　　　　　　 SearchFormat:=False, ReplaceFormat:=True
　　Next
End Sub
# 少し前から書式指定の置換はあったと思いますが、
# Versionの関係でうまくいかなければ失礼します。
# Versionを書いたほうがいいですよ。
・ツリー全体表示
【75980】Re:A列B列シートの文字をみて別シートの...
発言  kanabun  - 14/8/15(金) 0:08 -
引用なし
パスワード
   ▼daisuke さん：

Dictionaryを使ってみてはいかが？
まだ、色付けは考えてません。

Sub Try1()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　v = r.Value　'C列の値
　　For i = 1 To UBound(v)
　　　　If dic.Exists(v(i, 1)) Then '辞書にあったら値に置換
　　　　　　v(i, 1) = dic(v(i, 1))
　　　　End If
　　Next
　　r.Value = v '書き戻す
End Sub

文字色を変えるなら、
Sub Try2()
　　Dim dic As Object
　　Dim v
　　Dim i&
　　Dim r As Range, c As Range
　　
　　'----シート１ Ａ列をきーとして対応するB列を辞書に記憶
　　Set dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets(1).Range("A1").CurrentRegion.Resize(, 2).Value
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = v(i, 2)
　　Next
　　
　　'---- シート２
　　With Worksheets(2)
　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
　　End With
　　For Each c In r
　　　　If dic.Exists(c.Value) Then '辞書にあったら値に置換
　　　　　　c.Value = dic(c.Value)
　　　　　　c.Font.Color = vbRed
　　　　End If
　　Next
End Sub
といった感じですかね
・ツリー全体表示
【75979】A列B列シートの文字をみて別シートのC列...
質問  daisuke  - 14/8/14(木) 23:43 -
引用なし
パスワード
   シート１のA列に検索対象の文字とB列に置換対象の文字が
あります。シート１のA列の文字があったらシート２のC列にある
文字をシート１のB列の文字に置換し文字に赤色をつけたいです。
いままで手作業で置換していましたがマクロで効率化したいです。
どなたかご教授ください。よろしくお願いします。

シート１（A列検索対象とB列置換文字）
A列　　B列
R　　りんご
M　　みかん
.　　　.
.　　　.
.　　　.
S　　すいか

シート２
A列　　　B列　　C列
2014年　１月　　M
2014年　２月　　S
.　　 　 .　　　・
.　　 　 .　　　・
.　　 　 .　　　・
2014年　３月　　R

マクロで置換後
シート２
A列　　　B列　　C列
2014年　１月　　みかん(文字赤）
2014年　２月　　すいか(文字赤）
.　　 　 .　　　・
.　　 　 .　　　・
.　　 　 .　　　・
2014年　３月　　りんご(文字赤）
・ツリー全体表示
【75978】Re:exvel2013でのFileSearchの代替につい...
発言  kanabun  - 14/8/14(木) 23:05 -
引用なし
パスワード
   なんどもスミマセン m(_ _)m

また不具合が見つかりました。
主な変更は ◆か所ですが、他もあちこちブラッシュアップしてますので、
そっくり差し替えてください。

Function File_Search()　 'Dirコマンドによるファイル検索（Ver.3）
　　Dim LookIn As String
　　Dim Filename As String
　　Dim SearchSubFolders As Boolean
　　Dim tmpPath As String
　　Dim sCmd As String
　　Dim ng As Long
　　Dim j As Long
　　Dim n As Long
　　Dim io As Integer
　　Dim buf() As Byte
　　Dim ss As String
　　Dim FoundFiles() As String
　
　　For j = Cnt(0) To 1 Step -1
　　　　LookIn = Left$(TL_Path, Cnt(j))　'検索するフォルダ
　　　　SearchSubFolders = True　　　　 'Sub Folderも検索する
　　　　Filename = WK_Name　　　　　　　'検索するファイル名
　　　　If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"

　　'---- Dirコマンドによるサブフォルダを含むファイル名の検索
　　　　tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス

　　　　sCmd = "DIR """ & LookIn & Filename & """ /b/s/a:-D > """ _
　　　　　　　　& tmpPath & """"　　　　　　'' /b　ファイル名のみ
　　　　　　　　　　　　　　　　　　'' /s　サブディレクトリも検索
　　　　　　　　　　　　'' /a:-D サブディレクトリー名は表示しない
　　　　　　　　　　　　Debug.Print sCmd
　　　　　
　　　　'Dirコマンド実行(tmpファイルに出力)
　　　　With CreateObject("WScript.Shell")
　　　　　　ng = .Run("CMD /C " & sCmd, 7, True)
　　　　End With
　　　　If ng Then
　　　　　　Select Case ng
　　　　　　　Case 1: ss = "パス名が不正です" & vbCr & sCmd
　　　　　　　Case Else: ss = "ファイル検索時にエラー発生"
　　　　　　End Select
　　　　　　MsgBox ss & vbCr _
　　　　　　　& "処理を中断します", , LookIn & Filename
　　　　　　Open_SW = "Error"
　　　　　　Exit Function
　　　　End If

　　　　If FileLen(tmpPath) < 2 Then
　　　　　　'このパスでは見つからなかったとき
　　　　　　Debug.Print LookIn, Filename, "→ NO FILES"
　　　　　　Open_SW = "Error" '次に検索パスに飛ぶ
　　　　Else
　　　　'----- Dirコマンドで取得したファイル名を配列に格納
　　　　　　io = FreeFile()
　　　　　　Open tmpPath For Binary As io
　　　　　　　ReDim buf(1 To LOF(io))
　　　　　　　Get #io, , buf
　　　　　　Close io
　　　　　　Kill tmpPath
　　　　　　ss = StrConv(buf, vbUnicode)
　　　　　　FoundFiles() = Split(ss, vbCrLf)
　　　　　　'同名ファイルが存在した場合、フォルダのパスをセット
　　　　　　For i = 0 To UBound(FoundFiles) - 1
　　　　　　　　If FoundFiles(i) Like "*" & Filename & "*" Then
　　　　　　　　　　WK_Path = FoundFiles(i)
　　　　　　　　　　Open_SW = "OK"　 '取得成功
　　　　　　　　　　Exit Function　 '◆変更
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　Next j
　　MsgBox "【" & WK_Name & "】対象ファイルなし" & vbCr _
　　　　　　　　　 & "対象ファイルを準備後、処理して下さい。"
End Function
・ツリー全体表示
【75977】Re:exvel2013でのFileSearchの代替につい...
発言  kanabun  - 14/8/14(木) 20:37 -
引用なし
パスワード
   ▼佐藤　小次郎 さん：

ひまだから、デバッグにお付き合いしますよ(^^

>▼kanabun さん：

>D:\運行管理￥Tpt300運行支援TOOL￥D:運行管理￥Tpt300運行支援TOOL
>ファイル検索時にエラーが発生しました．
>処理を中断します

↑のファイルパス、全然おかしいですね

\がとちゅうから￥に代わり、
また D:\運行管理￥Tpt300運行支援TOOL と
　　 D:運行管理￥Tpt300運行支援TOOL　とが結合していますね！
なぜそうなるのか、
どこから呼び出したときにそうなるのか 考えてみましょう。

Mainのほうで 先ほどコメントしたとうり、 File_Search を呼び出している
ところは 2か所ありますね？

その2か所に ブレークポイントを置きましょう。（その行をマウスでポイント
して、ファンクションキーの[F9]を押してください。そうするとその行で
プログラムの実行がSTOP します）

Sub Auto_Open() を[F5]キーで実行します。
プログラムの実行は ブレークポイントで一時中断します。
そしたら [F8]キーを押してください。
[F8]キーはコードを一行だけ実行します。
コードの実行が Function File_Search() のほうに移ったら、コードを一行
[F8]で実行するたびに、実行行の変数が どのような値になったかを マウスを
変数のところにあてがって確認してください。
たとえば、
>　　　LookIn = Left(TL_Path, Cnt(j))　'検索するフォルダ
を実行した後の LookIn の値、

また、
>　　　　Filename = WK_Name　　　　　　　'検索するファイル名
を実行した後の Filename の値。

>　　If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
を実行した後の LookInの値。


>　　　　Filename = LookIn & Filename

な、なんと！！ 原因が分りました。↑ココです。
ここで Filename を　LookIn & Filename としていますが、実は この行は
不要な行だったのです。

すぐ後の行で
> sCmd = "DIR """ & LookIn & Filename & """ /b/s/a:-D > """ _
　　　　　　　　& tmpPath & """"　　'' /b　ファイル名のみ

としていますから、先行して

>　　　　Filename = LookIn & Filename

としておく必要はなかったんです。

ごめんなさい。とりあえず

>　　　　Filename = LookIn & Filename

の一行削除してください。
こういうのを デバッグといいます。
・ツリー全体表示
【75976】Re:exvel2013でのFileSearchの代替につい...
お礼  佐藤　小次郎  - 14/8/14(木) 19:52 -
引用なし
パスワード
   ▼kanabun さん：

ご高配、ご心配ありがとうございます。


>　　　　If ng Then
>　　　　　　MsgBox "ファイル検索時にエラーが発生しました." & vbCr _
>　　　　　　　& "処理を中断します", , LookIn & Filename
>　　　　　　Open_SW = "Error"
>　　　　　　Exit Function
>　　　　End If

のところで、

D:\運行管理￥Tpt300運行支援TOOL￥D:運行管理￥Tpt300運行支援TOOL
ファイル検索時にエラーが発生しました．
処理を中断します

表示されエラーとなってしまいます。

kanabunさまの大切なお時間をいただきましてありがとうございます。

これ以上、ご迷惑をおかけすることに心が痛むと同時に、kanabunさまに
書いていただいたものを見ながら、考えていきたいと思います。

できたら、ご報告させて頂きます。

ありがとうございました。
・ツリー全体表示
【75975】Re:exvel2013でのFileSearchの代替につい...
お礼  佐藤　小次郎  - 14/8/14(木) 18:52 -
引用なし
パスワード
   ▼kanabun さん：

ありがとうございます。

先程から教えていただきましたとおりにやっております。

なかなかうまくできなく、ご報告が遅れてしまっております。

結果が分かり次第、ご報告させて頂きます。

親身なご指導、ありがとうございます。
・ツリー全体表示
【75974】Re:exvel2013でのFileSearchの代替につい...
発言  kanabun  - 14/8/14(木) 17:44 -
引用なし
パスワード
   ▼佐藤小次郎 さん：

前掲の File_Search() 修正版ですが、モジュール全体を読み返していて
おおよその利用法が分り、修正版の不具合が見つかりましたので、以下に
修正第2版を提示しておきます。
試されるときは こちらを使ってください。

'//New File_Search
Function File_Search()　　　　　'Dirコマンドによるファイル検索
　　Dim LookIn As String
　　Dim Filename As String
　　Dim SearchSubFolders As Boolean
　　Dim tmpPath As String
　　Dim sCmd As String
　　Dim ng As Long
　　Dim j As Long
　　Dim n As Long
　　Dim io As Integer
　　Dim buf() As Byte
　　Dim FoundFiles() As String
　
　　For j = Cnt(0) To 1 Step -1
　　　　LookIn = Left(TL_Path, Cnt(j))　'検索するフォルダ
　　　　SearchSubFolders = True　　　　 'Sub Folderも検索する
　　　　Filename = WK_Name　　　　　　　'検索するファイル名
　　　　If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"

　　'---- Dirコマンドによるサブフォルダを含むファイル名の検索
　　　　Filename = LookIn & Filename
　　　　tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス

　　　　sCmd = "DIR """ & LookIn & Filename & """ /b/s/a:-D > """ _
　　　　　　　　& tmpPath & """"　　'' /b　ファイル名のみ
　　　　　　　　　　　　　　　　　　'' /s　サブディレクトリも検索
　　　　　　　　　　　　'' /a:-D サブディレクトリー名は表示しない
　　　　　
　　　　'Dirコマンド実行(tmpファイルに出力)
　　　　With CreateObject("WScript.Shell")
　　　　　　ng = .Run("CMD /C " & sCmd, 7, True)
　　　　End With
　　　　If ng Then
　　　　　　MsgBox "ファイル検索時にエラーが発生しました." & vbCr _
　　　　　　　& "処理を中断します", , LookIn & Filename
　　　　　　Open_SW = "Error"
　　　　　　Exit Function
　　　　End If

　　　　'----- Dirコマンドで取得したファイル名を配列に格納
　　　　If FileLen(tmpPath) < 2 Then
　　　　　　'このパスでは見つからなかったとき
　　　　　　Debug.Print LookIn, Filename, "→ NO FILES"
　　　　　　Open_SW = "Error" '次に検索パスに飛ぶ
　　　　Else
　　　　　　io = FreeFile()
　　　　　　Open tmpPath For Binary As io
　　　　　　　ReDim buf(1 To LOF(io))
　　　　　　　Get #io, , buf
　　　　　　Close io
　　　　　　Kill tmpPath
　　　　　　FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
　　　　　　'同名ファイルが存在した場合、フォルダのパスをセット
　　　　　　For i = 0 To UBound(FoundFiles) - 1
　　　　　　　　If FoundFiles(i) Like "*" & Filename & "*" Then
　　　　　　　　　　WK_Path = FoundFiles(i)
　　　　　　　　　　Open_SW = "OK"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　Next j
　　If Open_SW <> "OK" Then
　　　　MsgBox "【" & WK_Name & "】対象ファイルなし" & vbCr _
　　　　　　　　　 & "対象ファイルを準備後、処理して下さい。"
　　End If
End Function

前任者の方が コードにコメントをつけておいてくださったので、プログラム
の流れがつかめたのですが、それによりますと、
まず このマクロが書いてあるBookを立ち上げると、
２つのBook
　　　　"TEC103イベント一覧.xls"
　　　　"TEC104イベント対応.xls"
を開いて、UserForm上で更新処理をするようですね？

で、２つのBookが 最初に開くこのBook（ThisWorkbook） の保存されている
フォルダと同じフォルダにあればいいのですが、何らかの事情で、このBook
のあるフォルダのサブフォルダとか、このBookのあるフォルダと同列の別フォ
ルダとかに保存されていたばあい、それを探しに行くために

>　Function File_Search()

があるようなのですね。

一つ目が "TEC103イベント一覧.xls" の存在チェックで、これがこのBook と
同じフォルダ内になかったばあい、
以下で、他のフォルダ（近所からだんだん上位フォルダに範囲を広げて）に
検索に行っています。

>' イベント一覧.xlsの存在チェックで、NGの場合、再度検索を行う。
>' └イベント一覧　検索
>　　If Open_SW1 = "NG" Then
>　　　　WK_Name = "TEC103イベント一覧.xls"
>　　　　WK_Path = ""
>　　
>　　　　File_Search　　 'イベント一覧.xlsの検索
>　　
>　　　　If Open_SW = "Error" Then Exit Sub
>　　
>　　　　AD_Name1 = WK_Name
>　　　　AD_Path1 = WK_Path　'検索出来たイベント一覧.xlsの絶対パスをセット
>　　End If

２つめは イベント対応.xls のほうで、以下です。

> ' イベント対応.xlsの存在チェックで、NGの場合、再度検索を行う。
> ' └イベント対応　検索
>　　If Open_SW2 = "NG" Then
>　　　　WK_Name = "TEC104イベント対応.xls"
>　　　　WK_Path = ""
>　　
>　　　　File_Search　　 'イベント対応.xlsの検索

>　　　　If Open_SW = "Error" Then Exit Sub
>　　　　AD_Name2 = WK_Name
>　　　　AD_Path2 = WK_Path　'検索出来たイベント対応.xlsの絶対パスをセット
>　　End If

そしてこれ以外に FileSearch を呼び出しているところはありません。
作られた方は 「自動で」必要なファイルを開く、ということにたいへんこだわって
いらっしゃるようで、そのようなコーディングが随所にみられます。
その代わり、
対象とするBookのファイル名は
>　　　　"TEC103イベント一覧.xls"
>　　　　"TEC104イベント対応.xls"
に固定ですから、事情があって、他のファイル名で同じ処理をしようとしても
それができません。
ぼくがつくるなら、Application.GetOpenFilename メソッドをつかって
イベント一覧用Bookと イベント対応用Book を ユーザーにダイアログ使って
選択させます。
そうすれば、名前が変更されていても、マクロブックと同じフォルダになくても
ユーザーが指定したファイルをもとに処理ができるようになります。
このなが〜いプログラムはほとんど数行に簡素化できるでしょう。
・ツリー全体表示
【75973】Re:exvel2013でのFileSearchの代替につい...
お礼  佐藤小次郎 E-MAIL  - 14/8/13(水) 15:56 -
引用なし
パスワード
   ▼kanabun さん：
　
大変失礼いたしました。

早急に対処いたします。

ありがとうございました。
・ツリー全体表示
【75972】Re:exvel2013でのFileSearchの代替につい...
発言  kanabun  - 14/8/13(水) 15:05 -
引用なし
パスワード
   ▼佐藤小次郎 さん：

>親身になりご心配していただき、とても嬉しかったです。

他の掲示板の方にもレスがついています。

ここの掲示板の基本ポリシーにもありますように、
> 質問しっぱなし、というのはモラルに反します。
> 解決したからいいや」というのではありません。

善処してください。
・ツリー全体表示
【75971】Re:exvel2013でのFileSearchの代替につい...
お礼  佐藤小次郎 E-MAIL  - 14/8/13(水) 12:02 -
引用なし
パスワード
   ▼γ さん：

ありがとうございます。

なんとか、みてみます。
・ツリー全体表示
【75970】Re:exvel2013でのFileSearchの代替につい...
お礼  佐藤小次郎 E-MAIL  - 14/8/13(水) 12:00 -
引用なし
パスワード
   ▼kanabun さん：

お手数をおかけいたしました。

ありがとうございました。

なんとか修正してみます。

今はいないものが作っておいていったものでした。

親身になりご心配していただき、とても嬉しかったです。
・ツリー全体表示
【75969】Re:exvel2013でのFileSearchの代替につい...
発言  kanabun  - 14/8/13(水) 9:40 -
引用なし
パスワード
   ▼佐藤小次郎 さん：

>　　Public WK_Name　　As String'ワーク用イベント一覧名（ファイル名）
>　　Public WK_Path　　As String　' ワーク用イベント一覧のフルパス名

>　　Public Cnt(60)　 ' カウンタの配列（イベント表検索にて使用）

>　　Public i, j, k　　　　　　　　　　　　　　　 ' 添字エリア
>
>Sub Auto_Open()

ぼくは Cnt(0) って何ですか？と聞いたのですから、〜用カウンタの配列
で Cnt(0) には 通常 5〜10くらいのカウンタが入っています... とか、
そういうことが知りたかったのですが。

元の Function File_Search() を
Function File_Search_Old()
とかに名前を変えてから、
以下の あたらしい Function File_Search() を挿入して、
試してみてください。

このコードは
ht tp://www.vbalab.sakura.ne.jp/vbaqa/c-board.cgi?cmd=one;no=74578;id=excel
を参考に、DirコマンドによりFileSearch代替処理を行っています。

Function File_Search()　　　　　'Dirコマンドによるファイル検索
　　Dim LookIn As String
　　Dim Filename As String
　　Dim SearchSubFolders As Boolean
　　Dim tmpPath As String
　　Dim sCmd As String
　　Dim ng As Long
　　Dim j As Long
　　
　　Open_SW = "OK"
　　j = cnt(0)
　　Do Until j = 0
　　　　LookIn = Left(TL_Path, cnt(j))　'検索するフォルダ
　　　　SearchSubFolders = True　　　　 'Sub Folderも検索する
　　　　Filename = WK_Name　　　　　　　'検索するファイル名
　　　　If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
　
　　'---- Dirコマンドによるサブフォルダを含むファイル名の検索
　　　　Filename = LookIn & Filename
　　　　tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス

　　　　sCmd = "DIR """ & LookIn & Filename & """ /b/s/a:-D > """ _
　　　　　　　　& tmpPath & """"　　'' /b　ファイル名のみ
　　　　　　　　　　　　　　　　　　'' /s　サブディレクトリも検索
　　　　　　　　　　　　'' /a:-D サブディレクトリー名は表示しない
　　　　　　　　　　　
　　　　'Dirコマンド実行(tmpファイルに出力)
　　　　With CreateObject("WScript.Shell")
　　　　　　ng = .Run("CMD /C " & sCmd, 7, True)
　　　　End With
　　　　If FileLen(tmpPath) < 2 Then ng = -10 'ファイルなし
　　　　If ng Then
　　　　　　MsgBox "【" & WK_Name & "】対象ファイルなし" & vbCr _
　　　　　　　　　 & "対象ファイルを準備後、処理して下さい。"
　　　　　　Open_SW = "Error"
　　　　　　Exit Function
　　　　End If

　　　　'----- Dirコマンドで取得したファイル名を配列に格納
　　　　Dim n As Long
　　　　Dim io As Integer
　　　　Dim buf() As Byte
　　　　Dim FoundFiles() As String
　　　　io = FreeFile()
　　　　Open tmpPath For Binary As io
　　　　　ReDim buf(1 To LOF(io))
　　　　　Get #io, , buf
　　　　Close io
　　　　Kill tmpPath
　　　　FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
　　　　n = UBound(FoundFiles) - 1
　　　　ReDim Preserve FoundFiles(n)
　　　　'同名ファイルが存在した場合、フォルダのパスをセット
　　　　For i = 0 To n
　　　　　　If "\" & Filename = Right$(FoundFiles(i), 17) Then
　　　　　　　　WK_Path = FoundFiles(i)
　　　　　　　　Exit Do
　　　　　　End If
　　　　Next
　　　　
　　　　j = j - 1
　　Loop

End Function

Public 変数が多用されているので、
何がどう関係しているのか、サッパリ分りませんので、コードの字面だけ
Dirコマンドに置換しただけです。
うまく行くかどうかは たぶん 半々です。

それにしても

> Public i, j, k

はどうみてもおかしいですね？
・ツリー全体表示
【75968】Re:exvel2013でのFileSearchの代替につい...
発言  γ  - 14/8/13(水) 8:27 -
引用なし
パスワード
   FileSearch は Office2007以降は含まれていませんから、
「FileSearch 2007」などとネット上で検索すれば、いくらでも
見つかります。
例えば、
ht　tp://d.hatena.ne.jp/language_and_engineering/20090429/p1
はどうですか？

これほどのコードを書けるかたが、
>書き換えをお願いできないでしょうか。
というのはどうなんでしょうか？

上のサイトの記事を参考に、自分で書換えてください。
コンパイルエラーがでるようなコードを、
下請けして書き換える暇もないです。
# まあ、私のコメントも労力節約型だから、同じ穴の狢ですけど。
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
322 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free