[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セルに色を付けたいです。』(アイコス買えた)
参考にさせてもらっています。
以下のようなことは可能なのでしょうか?
エクセル A1に Z1-1 と入力
A2に B3-2 と入力
・・・・・
A50に Q31-7・・・
Aに入力するのは アルファベットと数字です。
ディスクトップにフォルダを作成、名前を仮にフォルダ1とします。
その中に Z1-1 のdxfファイルを入れる。
同じ名前があるときにAのセルに色が付く(Aでなくてもいいです。)
この場合だとA1(B1等でも問題ありません)に色が付く
可能なものでしょうか?
ヨロシクお願いします。
< 使用 Excel:Excel2003、使用 OS:unknown >
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim c As Range Dim fPath As String
Set r = Intersect(Target, Columns("A")) If r Is Nothing Then Exit Sub
fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\フォルダ1\" r.Interior.ColorIndex = xlNone
For Each c In r If Dir(fPath & c.Value & ".txt") <> "" Then c.Interior.Color = vbRed Next
End Sub
(β) 2017/03/27(月) 16:59
もしかして 関数処理がご希望?
その場合は、どこか別の場所に フォルダ内のファイル一覧をつくっておいて、 セルの値が、そのリストにあるかないか、MATCHあたりで検索してあった場合に色をつける条件付書式になると思います。
そのフォルダ内のファイル一覧を手入力するのは面倒ということであれば、それを取り出してシート上に展開する部分を マクロにしておいて、実行しておくという手もあります。
(β) 2017/03/27(月) 17:35
返信を書いている間にかぶりました。
VBEはよく分からないのでコピー貼付けをしたのですが
上手くいきませんでした。
やったこと
エクセルを開いて Alt + F11 で画面を開く
左画面の Microsoht Excrl下のSheet1をダブルクリックして画面を開く
返信のあった式をコピー貼付け
右上の × をクリックして画面を閉じる
です。
エクセルを一度閉じて開くと マクロを有効にしますか?とは聞かれます。
有効にしますをクリックしていますが、色がつきません。
よろしくお願いします。
(アイコス買えた) 2017/03/27(月) 17:39
dxf にしたら希望通りになりました。
このくらいは自分で確認しないといけませんでした、すみません。
βさん mmさん ありがとうございます。
(アイコス買えた) 2017/03/27(月) 18:18
上で問題ないと思っていたのですが
フォルダにデータがある場合は問題なかったのですが
エクセルに入力してからフォルダにデータを入れると
色が付きません。
その場で色が付かなくてもいいのですが、保存して開いた時には色が付いているとうれしいです。
フォルダに「A1-1」データが入った状態でエクセルに「A1-1」を入力すると色が付く
エクセルに「A1-1」を入力してから、フォルダに「A1-1」を保存する、色が付かない
エクセル保存して、再び開いても色が付いていない。
Aをコピー貼付けすればいい話なのですが、複数のシートでこれを使わせてもらっているので
なるべく手間を省きたいと思っています。
よろしくお願いします。
(アイコス買えた) 2017/03/29(水) 09:31
>複数のシートでこれを使わせてもらっているので
それでは、現在書いてあるシートモジュールのコードをすべて消してください。
で、あらためて ThisWorkbookモジュールに以下を貼り付け、保存して閉じたうえで、開きなおしてみてください。
なお、★印のところは実際の対象シート名に変えてください。
Private Sub Workbook_Open() Dim sh As Worksheet For Each sh In Worksheets If ToDo(sh) Then With sh.Range("A1", sh.Range("A" & Rows.Count).End(xlUp)) .Value = .Value End With End If Next End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) Dim r As Range Dim c As Range Dim fPath As String If ToDo(sh) Then Set r = Intersect(Target, sh.Columns("A")) If r Is Nothing Then Exit Sub
fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\フォルダ1\" r.Interior.ColorIndex = xlNone
For Each c In r If Dir(fPath & c.Value & ".dxf") <> "" Then c.Interior.Color = vbRed Next End If End Sub
Private Function ToDo(sh As Worksheet) As Boolean Select Case sh.Name Case "Sheet1", "Sheet2", "Sheet3" '★対象シートをいくつでも列挙 ToDo = True End Select End Function
(β) 2017/03/29(水) 09:56
分かりやすく早い返答ありがとうございます。
1回で思っていた通りの事が出来ました。
ありがとうございます。
(アイコス買えた) 2017/03/29(水) 11:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.