Excelで、条件に該当するデータに「／(罫線)」を引きたいです。

Question

Excelで困っています(>_<)
今、ファイルが二つあります。

一つめのファイルは『野菜＆果物ファイル.xls』、二つ目のファイルは『果物ファイル.xls』とファイル名を付けています。
一つめのファイルには、

セロリ
マンゴー
バナナ
トマト
リンゴ
白菜
ホウレンソウ
イチゴ
・
・
・

と、野菜と果物の名前がA1からずら～っと縦に並んでいます。
二つ目のファイル『果物ファイル.xls』には、

バナナ
リンゴ
イチゴ
・
・
・

と、A1から果物の名前だけがずら～っと並んでいます。

ここで、『果物ファイル.xls』にある全果物のデータを参照し、『野菜＆果物ファイル.xls』の中で、一致するデータ(果物)があれば、その該当データに「／(罫線)」を引きたいのです。
そして、野菜のデータと果物のデータの区別を、視覚的にわかりやすくしたいのです。

「色をつける」「網をかける」のでも大丈夫なのですが、モノクロでプリントアウトした際も一目でわかるのはやはり、「／(斜線)」だと思いまして。

関数やマクロを使って、何とか解決できないでしょうか？

merlionXX · Accepted Answer

No3-4　merlionXXです。
No4の再質問の書き込みを見ました。
罫線は並べ替えても移動してくれませんからね。
それなら並べ替えてから罫線をひくことになります。
こんなんでどうでしょ？

Sub test03()
    Dim myRng1 As Range, myRng2 As Range, c As Range, cc As Range
    With Workbooks("野菜＆果物ファイル.xls").Sheets("Sheet1")
        Set myRng1 = .Range(.Range("A1"), .Range("A1").End(xlDown))
        myRng1.Borders(xlDiagonalUp).LineStyle = xlNone
        .Columns("B:B").Insert Shift:=xlToRight
    End With
    With Workbooks("果物ファイル.xls").Sheets("Sheet1")
        Set myRng2 = .Range(.Range("A1"), .Range("A1").End(xlDown))
    End With
    For Each c In myRng1
        For Each cc In myRng2
            If c.Value = cc.Value Then
                c.Offset(0, 1).Value = 1
            End If
        Next cc
    Next c
    With Workbooks("野菜＆果物ファイル.xls").Sheets("Sheet1")
        .Range(myRng1, myRng1.End(xlToRight)).Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo, Orientation:=xlTopToBottom
        With .Range(.Range("B1"), .Range("B1").End(xlDown)).Offset(0, -1).Borders(xlDiagonalUp)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Columns("B:B").Delete Shift:=xlToLeft
    End With
End Sub

merlionXX · Answer

myRng1.Borders(xlDiagonalUp).LineStyle = xlNone　は斜めの罫線を削除しています。
ひょっとして、シート保護してませんか？
保護してると手動でも罫線の削除はできませんのでマクロでもエラーになります。

merlionXX · Answer

merlionXXです。
No5で回答した　Sub test03　を、エクセル2000、2003、2007の３バージョンで実行してみましたが、そのようなエラーは再現できませんでした。

merlionXX · Answer

No3 merlionXXです。
先ほどのでも大丈夫とは思いますが、念のため修正します。

Sub test02()
    Dim myRng1 As Range, myRng2 As Range, c As Range, cc As Range
    With Workbooks("野菜＆果物ファイル.xls").Sheets("Sheet1")
        Set myRng1 = .Range(.Range("A1"), .Range("A1").End(xlDown))
        myRng1.Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    With Workbooks("果物ファイル.xls").Sheets("Sheet1")
        Set myRng2 = .Range(.Range("A1"), .Range("A1").End(xlDown))
    End With
    For Each c In myRng1
        For Each cc In myRng2
            If c.Value = cc.Value Then
                With c.Borders(xlDiagonalUp)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
            End If
        Next cc
    Next c
End Sub

merlionXX · Answer

マクロでも良いとのことなので一例です。
BOOK名はありましたがSheet名がないので２つのBOOKともSheet1だとします。
データは両方ともA1セルから下へ縦に一列にあるものとします。
データは途中に空白はないものとします。
両方のBOOKを開いた状態で以下のマクロを実行してください。

Sub test01()
    Set bk1 = Workbooks("野菜＆果物ファイル.xls")
    Set bk2 = Workbooks("果物ファイル.xls")
    With bk1
    Set myRng1 = .Sheets("Sheet1").Range(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet1").Range("A1").End(xlDown))
    End With
    With bk2
    Set myRng2 = .Sheets("Sheet1").Range(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet1").Range("A1").End(xlDown))
    End With
    
    For Each c In myRng1
        For Each cc In myRng2
            If c.Value = cc.Value Then
                With c.Borders(xlDiagonalUp)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
            End If
        Next cc
    Next c
End Sub

imogasi · Answer

VBAでやらないと出来ないでしょう。
それも変更即時反応型は難しい。
ーーー
近い機能は条件付き書式なのです。
Ａ．そしてその条件で「数式が」を選ぶことで、ＶＬＯＯＫＵＰのような（検索）関数も使えるでしょうし、
Ｂ．条件に合ったものに罫線も引けます
ーー
しかし問題は、相手側に「一致するデータ(果物)があれば」ですが
複数有るときは、第2番目以降を捉えることが関数では難しい(普通で不可能）なのです。
その重複出現あるかどうかのことを質問に書いてないのは、コンピュタ利用経験が少ない証拠です。これをデータの寄せ集まりでは、いつも意識すること。処理に大きく影響します。
ただ相手の検索する表に本件のように、有るかないかを調べるだけなら、２番目以降の重複出現は関係ない（１つめが見つかればとにかくあると言える）ですが。
ーー
では
ＩＳＥＲＲＯＲとＶＬＯＯＫＵＰの組み合わせで出来そうか考えます。
普通に式を書くと、参照する検索表が他シートだとエラーになる。他ブックならましてダメ。
Ｓｈｅｅｔ１とＳｈｅｅｔ２の例ですと
例データ
Ｓｈｅｅｔ１
Ａ１：Ａ５
aaa
bbb
cc
ddd
ee
これに範囲に名前をつける（ここでは、検索という名前とする）
Ｓｈｅｅｔ２に
Ａ１：Ａ５に
aa
bb
cc
dd
ee
と有るとする。
ーー
Ｓｈｅｅｔ２のＡ１：Ａ５（データ全て）を範囲指定する。そして
書式ー条件付き書式ー数式が
数式に　=NOT(ISERROR(VLOOKUP(A1,検索,1,FALSE)))
書式に　セルのパターン色でライトブルーを指定ーＯＫ
ーー
結果
ｃｃ、eeに色がつきました。
ーー
書式をパターン色にしたのは、私のバージョンの場合、罫線で斜線が出てこないからです。質問者の場合、出てくればそれでやってください。
ーー
他ブックの場合ですが、同じくセル範囲に名前をつけるほか無いと思うが、質問者でやってみてください。うまく行くとは思いますが、ブックがちがうと、エクセルでは他世界で、何かと難しくなったり、不可能に有る場合はあります。
セル範囲に名前をつける問題で、シートレベル、ブックレベルなどあり、特別に勉強が必要だと思う、分野だと思います。

082 · Answer

スマートではないですが、関数でできそうです。

(1)野菜＆果物ファイル.xlsのB列に以下の式を入力します。
=ISERROR(MATCH(A1,[果物ファイル.xls]Sheet1!$A$1:$A$3,0))

(2)野菜＆果物ファイル.xlsのA列の値が入力されているセルを全て
　選択し、書式⇒条件付書式を選択し、『数式が』『=$B1=FALSE』
　と入力し、書式を設定する。

※残念ながら斜線は引きないみたいですが、濃い目の色をつければ、
　白黒印刷でも区別できると思います。

Excelで、条件に該当するデータに「／(罫線)」を引きたいです。

myRng1.Borders(xlDiagonalUp).LineStyle = xlNone は斜めの罫線を削除しています。

merlionXXです。

No3-4 merlionXXです。

No3 merlionXXです。

マクロでも良いとのことなので一例です。

VBAでやらないと出来ないでしょう。

スマートではないですが、関数でできそうです。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

myRng1.Borders(xlDiagonalUp).LineStyle = xlNone　は斜めの罫線を削除しています。

No3-4　merlionXXです。