エクセルの結果欄の表示

質問

エクセルの結果欄の表示方法について、教えてください。
画像で表1、表2を貼付けましたが、現段階で私が作成できるものが表1で、目指す完成型が表2です。
［B］列～［F］列までの入力結果を、行ごとに［G］列で表示判定させる表をつくりたいのです。

表示する時のきまりを挙げると、
1.　［B］列～［F］列の"-"は無視する
2.　×のみの場合："確認"と表示させ、ピンク色（(2)表の［G13］,［G16］）
3.　×と、異なる果実名が混在する場合："果実名を表示"させ、ピンク色（(2)表の［G17］）
4.　×がなく、異なる果実名が混在する場合："果実名を表示"させ、ピンク色（(2)表の［G14］,［G18］）
5.　果実名が一つの場合：上記1.～3.に該当しない場合は、果実名を表示させ、セルは無色（(2)表の［G12］,［G15］）
※3.の場合、×を含んだ表示(×,りんご,すいか)でも構わないが、セルはピンク色

表1ですが、［G2］に
IF(COUNTIF(B2:F2,"×"),"確認",CONCATENATE(B2,",",C2,",",D2,",",E2,",",F2))
をいれて、下にコピーし、セルの塗りは、条件付き書式で、"発注"の時にピンク色のパターンをつけるように設定しました。
簡単な関数の組合せができる程度なので、完成型には程遠い状態です。

表2のように仕上がるのがベストなのですが、難しいようであれば、条件にあうセルの色付けを最優先とし、文字の表示はCONCATENATEで繋げたままでも構いません。（表1の白色セルのように）

どなたか御教示いただければ、ありがたいです。
よろしくお願いいたします。

回答No.9

kagakusuki · ベストアンサー

ANo.5です。

>［G7］の"×,りんご,すいか"を、"りんご,すいか"と表示させてはいただけないでしょうか?

　それならば、G2セルに数式を入力する際に、入力する数式を、次の様に変更して下さい。

=IF(AND(COUNTIF($B2:$F2,"×")>0,COUNTIF($B2:$F2,"<>×")-COUNTIF($B2:$F2,"-")-COUNTIF($B2:$F2,"")=0),"確認",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(","&$B2&IF(COUNTIF($B2:$C2,$C2)=1,","&$C2,"")&IF(COUNTIF($B2:$D2,$D2)=1,","&$D2,"")&IF(COUNTIF($B2:$E2,$E2)=1,","&$E2,"")&IF(COUNTIF($B2:$F2,$F2)=1,","&$F2,""),",-",),",×",),",",,1))

　それと、G2セルに条件付き書式を設定する際に、「条件付き書式の設定」ウィンドウの右端の欄にに入力する数式を、次の様に変更して下さい。

=OR(NOT(ISERROR(FIND(",",G2))),COUNTIF($B2:$F2,"×"))

お礼

パーフェクトです!! ありがとうございました。

今回、多数の皆様に、様々な方法をご教示いただきましたが、
中には、私が未熟なため、動かすことができないという残念な結果をみたものもあり、
勉強不足を痛感しております。

皆様には貴重なお時間を割いていただきまして、大変感謝しております。
この場を借りて、お礼申し上げます。

これに懲りずに、また次回教えていただけたらありがたいです。

回答No.10

某HN クロメート(Chromate)（@CoalTar）

出遅れた～
G2セルに
=IF(TRIM("^"&SUBSTITUTE(SUBSTITUTE(PHONETIC(B2:F2),"×"," "),"-","")&"^")="^ ^","確認",
SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(
B2&" "&IF(COUNTIF(B2:B2,C2),"",C2)&" "&IF(COUNTIF(B2:C2,D2),"",D2)
&" "&IF(COUNTIF(B2:D2,E2),"",E2)&" "&IF(COUNTIF(B2:E2,F2),"",F2),
"-"," "),"×"," "))," ",","))

1行目確認の判定 「×」があってくだものがない場合、「確認」とする
3、4行目 重複の無いようにに文字をつなげる
2,5行目、「-」、「×」、余分な空白の文字の削除と「,」の置換

条件付き書式はG2セルから対象となるセル範囲を選択して
数式が =OR($G2="確認",ISNUMBER(FIND(",",$G2)))
[書式]で色づけ

お礼

私の拙い質問に、いつもご投稿いただきまして、ありがとうございます。

式を貼付けてみましたところ、"確認"と表示されるべきセル(［G3］［G6］)が空欄になってしまいます。
勉強のため、自力で関数を修正してみたいと思います。

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

回答No.8

Wendy02

#6の回答者です。
質問文では「×」この文字って、アルファベットのXの全角とかではないようです。まさか、「バツ(×）」と、全角変換するとは思わなかったですが、両方まかなえるようにしました。なお、#6では、書式クリアするようになっていたものを、罫線が消えてしまうので、ペイントを塗りつぶしなしにしました。

このような表は、本来数式で済ませるべきかもしれませんし、ユーザー定義関数でも作れます。あえて、マクロのメリットは、メモリ負担が少ないからと、入力のブレにはある程度、賄うことが出来るということです。

'//
Sub ProductsChecker1R()
　Dim rng As Range, ret As Variant
　Dim buf As String
　Dim ar As Variant
　Dim c As Variant, n As Variant, i As Long
　Dim flg As Boolean
　With ActiveSheet
　　Set rng = .Range("B2", .Cells(Rows.Count, 2).End(xlUp))
　End With
　rng.Offset(, 5).Resize(, 1).Interior.ColorIndex = xlNone
　Application.ScreenUpdating = False
　For Each c In rng
　　If c.Value <> "" Then
　　　ar = Application.Index(c.Resize(, 5).Value, 1, 0)
　　　For Each n In ar
　　　　If StrComp(Trim(n), "x", 1) <> 0 And StrComp(Trim(n), "-", 1) <> 0 And StrComp(Trim(n), "×", 1) <> 0 Then
　　　　　If InStr(1, buf, n, 1) = 0 Then
　　　　　　buf = buf & "," & n
　　　　　End If
　　　　End If
　　　Next
　　　If Not c.Offset(, 5).Value Like "*結果*" Then
　　　　If Len(buf) > 1 Then
　　　　　c.Offset(, 5).Value = Mid(buf, 2)
　　　　　buf = Mid(buf, 2)
　　　　Else
　　　　　c.Offset(, 5).Value = "確認"
　　　　End If
　　　　'色付け条件
　　　　i = InStr(1, Join(ar, ","), "x", 1) + InStr(1, Join(ar, ","), "×", 1)
　　　　If i > 0 Then
　　　　　flg = True
　　　　ElseIf Len(buf) - Len(Replace(buf, ",", "")) > 0 Then
　　　　　flg = True
　　　　End If
　　　　If flg Then
　　　　　c.Offset(, 5).Interior.ColorIndex = 7
　　　　End If
　　　　flg = False
　　　End If
　　End If
　　buf = ""
　Next
　Application.ScreenUpdating = True
　Set rng = Nothing
End Sub

お礼

二度にわたるご投稿ありがとうございます。
説明不足ですみません。表中の"×"は、全角エックスではなく、"ばつ"です。以後気をつけます。

ご教示いただいたコードを、"コードの表示"にコピペして閉じたのですが、私のやり方が悪いのか、何も表示されないのです。
処置の仕方がまったくわからないため、マクロの実行ができませんでした。
動作確認もできず、残念です。すみません。
勉強させていただきます。

回答No.7

tom04

No.1・2です！
またまたお邪魔します。

無理矢理って感じのコードにしてみました。
もう一度↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test() '←この行から
Dim i, j, k As Long
Dim str, buf As String
k = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To k
For j = 2 To 6
If Cells(i, j) <> "－" And Cells(i, j) <> "×" And _
WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, j)), Cells(i, j)) = 1 Then
str = Cells(i, j)
buf = buf & "," & str
End If
Next j
Cells(i, 7) = buf
buf = ""
Next i
Dim L, M As Long
For L = 2 To k
If Cells(L, 7) = "" Then
With Cells(L, 7)
.Value = "確認"
.Interior.ColorIndex = 7
End With
ElseIf WorksheetFunction.Find(",", Cells(L, 7)) Then
Cells(L, 7) = WorksheetFunction.Substitute(Cells(L, 7), ",", "", 1)
End If
Next L
For M = 2 To k
If Cells(M, 7) Like "*" & "," & "*" Then
Cells(M, 7).Interior.ColorIndex = 7
End If
Next M
End Sub '←この行まで

それから・・・
＞1.表が終わっている9行目以降も、しばらく結果欄に"確認"が表示されてしまいます。

とあるのですが、前回も今回もコードはB列の最終行まで操作を繰り返すコードにしていましたので
9行目以降になにかデータが入っていないでしょうか？

もしそうであれば必要ないB列のデータはDeleteで削除するか、
もしくはコード内の　
k = Cells(Rows.Count, 2).End(xlUp).Row
の部分がB列の最終行を取得するようにしていますので、ここで調整する方法ですかね。

「2」がB列の列番号になりますので、これを他の列の番号にするか、
仮に最終行が決まっているのであれば
単純に　ｋ=20　のように最後の行番号を設定してしまう方法もあります。

今回は希望通りになれば良いのですが・・・m(__)m

お礼

度々のご投稿、ありがとうございます。
"コードの表示"で、コードをコピペして閉じようとすると、
"コンパイルエラー:END Subが必要です"というメッセージが出てきてしまいました。
処置の仕方がまったくわからないので、マクロの実行ができませんでした。
動作確認もできず、残念です。すみません。
勉強させていただきます。

回答No.6

Wendy02

>3.　×と、異なる果実名が混在する場合："果実名を表示"させ、ピンク色（(2)表の［G17］）
>4.　×がなく、異なる果実名が混在する場合："果実名を表示"させ、ピンク色（(2)表の［G14］,［G18］）

この部分は、x があるなしに関わらず、単に、「異なる果実名が混在する場合」だと思います。
色付けサンプル画像は、表2のみを有効にしました。ただ、マクロは気をつけたものの、人が手入力する時のブレに完全対応しているわけではありません。

違うようでしたら、簡単な理由付けを添えてお答えください。

'//
Sub ProductsChecker1()
　Dim rng As Range
　Dim ret As Variant
　Dim buf As String
　Dim ar As Variant
　Dim c As Variant, n As Variant
　Dim flg As Boolean
　With ActiveSheet
　　Set rng = .Range("B2", .Cells(Rows.Count, 2).End(xlUp))
　End With
　rng.Offset(, 5).Resize(, 1).ClearFormats
　Application.ScreenUpdating = False
　For Each c In rng
　　If c.Value <> "" Then
　　　ar = Application.Index(c.Resize(, 5).Value, 1, 0)
　　　For Each n In ar
　　　　If StrComp(Trim(n), "x", 1) <> 0 And StrComp(Trim(n), "-", 1) <> 0 Then
　　　　　If InStr(1, buf, n, 1) = 0 Then
　　　　　　buf = buf & "," & n
　　　　　End If
　　　　End If
　　　Next
　　　If Not c.Offset(, 5).Value Like "*結果*" Then
　　　　If Len(buf) > 1 Then
　　　　　c.Offset(, 5).Value = Mid(buf, 2)
　　　　　buf = Mid(buf, 2)
　　　　Else
　　　　　c.Offset(, 5).Value = "確認"
　　　　End If
　　　　'色付け条件
　　　　If Application.CountIf(c.Resize(, 5), "x") > 0 Then
　　　　　flg = True
　　　　ElseIf Len(buf) - Len(Replace(buf, ",", "")) > 0 Then
　　　　　flg = True
　　　　End If
　　　　If flg Then
　　　　　c.Offset(, 5).Interior.ColorIndex = 7
　　　　End If
　　　　flg = False
　　　End If
　　End If
　　buf = ""
　Next
　Application.ScreenUpdating = True
　Set rng = Nothing
End Sub

回答No.5

kagakusuki

まず、G2セルに次の数式を入力して下さい。

=IF(AND(COUNTIF($B2:$F2,"×")>0,COUNTIF($B2:$F2,"<>×")-COUNTIF($B2:$F2,"-")-COUNTIF($B2:$F2,"")=0),"確認",MID(IF($B2<>"-",","&$B2,"")&IF(AND($C2<>"-",COUNTIF($B2:$C2,$C2)=1),","&$C2,"")&IF(AND($D2<>"-",COUNTIF($B2:$D2,$D2)=1),","&$D2,"")&IF(AND($E2<>"-",COUNTIF($B2:$E2,$E2)=1),","&$E2,"")&IF(AND($F2<>"-",COUNTIF($B2:$F2,$F2)=1),","&$F2,""),2,999))

　次に、以下の操作を行って、G2セルに条件付き書式を設定して下さい。

G2セルをクリックして選択
　　↓
メニューの[書式]をクリック
　　↓
現れた選択肢の中にある[条件付き書式]をクリック
　　↓
現れた「条件付き書式の設定」ウィンドウの左端の欄をクリック
　　↓
現れた選択肢の中にある「数式が」をクリック
　　↓
「条件付き書式の設定」ウィンドウの右端の欄に次の数式を入力

=OR(NOT(ISERROR(FIND(",",G2))),G2="確認")

　　↓

「条件付き書式の設定」ウィンドウの[書式]ボタンをクリック
　　↓
現れた「セルの書式設定」ウィンドウの[パターン]タグをクリック
　　↓
ピンク色の四角形をクリック
　　↓
「セルの書式設定」ウィンドウの[OK]ボタンをクリック
　　↓
「条件付き書式の設定」ウィンドウの[OK]ボタンをクリック

　そして、G2セルをコピーして、G3以下に貼り付けて下さい。
　以上です。

お礼

私の拙い質問に、いつもご投稿いただきまして、ありがとうございます。

ご指示通りに操作しましたところ、できました!
すばらしいです。
ここまで作っていただけると、より完璧なものを望まずにはいられなくなりました。

［G7］の"×,りんご,すいか"を、"りんご,すいか"と表示させてはいただけないでしょうか?

未熟者なので簡単にお願いしていますが、もしとても面倒なことであれば、現状で十分満足していますので、もしお時間があれば…ということで、よろしくお願いいたします。

回答No.4

maron--5

◆式を見直しました（すこし、短くなりました）
G2=IF(COUNTIF(B2:F2,"×"),"確認",SUBSTITUTE(TRIM(SUBSTITUTE(B2&" "&IF(COUNTIF(B2:C2,C2)>1," ",C2)&" "&IF(COUNTIF(B2:D2,D2)>1," ",D2)&" "&IF(COUNTIF(B2:E2,E2)>1," ",E2)&" "&IF(COUNTIF(B2:F2,F2)>1," ",F2),"-"," "))," ",","))
★下にコピー

お礼

２度にわたるご投稿、ありがとうございます。そしてお礼が遅くなり、申し訳ありません。

ご教示いただいた式を貼付けてみたのですが、
表1［G7］が"確認"と表示され、求める結果(表2［G17］の"りんご,すいか")が、得られませんでした。
あと、結果によるセルの色付けについての、ご教示もいただければ大変ありがたいです。

もしお時間があれば、よろしくお願いいたします。

回答No.3

maron--5

G2=IF(COUNTIF(B2:F2,"×"),"確認",SUBSTITUTE(TRIM(SUBSTITUTE(B2&" "&IF(INDEX(COUNTIF(B2:C2,B2:C2),2)>1," ",C2)&" "&IF(INDEX(COUNTIF(B2:D2,B2:D2),3)>1," ",D2)&" "&IF(INDEX(COUNTIF(B2:E2,B2:E2),4)>1," ",E2)&" "&IF(INDEX(COUNTIF(B2:F2,B2:F2),5)>1," ",F2),"-"," "))," ",","))
★下にコピー

回答No.2

tom04

No.1です！
たびたびごめんなさい。

投稿した後に気づきました。
画像の配置では前回のコードでは動かないはずです。
前回はA列からデータがあり、結果の列がF列のコードですので、
もう一度訂正したコードを載せておきます。
データは2行目からとしています。

Sub test()
Dim i, j As Long
Dim str, buf As String
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
For j = 2 To 6
If Cells(i, j) <> "－" And Cells(i, j) <> "×" Then
str = Cells(i, j)
buf = buf & str
End If
Next j
Cells(i, 7) = buf
If Cells(i, 7) = "" Then
With Cells(i, 7)
.Value = "確認"
.Interior.ColorIndex = 7
End With
End If
buf = ""
Next i
End Sub

これならお示しの画像の配置で大丈夫だと思います。

前回より少しコードを短くしてみました。
何度もごめんなさいね。m(__)m

お礼

深夜にも関わらず２度にわたるご投稿、ありがとうございます。そして、お礼が遅くなり申し訳ありません。
VBAが初めてなので戸惑いましたが、ご指示通りにコピベしたところ、
ほぼ完成型に近いものが表示されましたので、感嘆の叫び声をあげてしまいました。
ただ、さらにご教示いただきたいところがあり、以下に挙げさせていただきました。

1.表が終わっている9行目以降も、しばらく結果欄に"確認"が表示されてしまいます。
2.果実名が複数ある場合に、"柿ミカン柿"［G8］と表示されてしまうので、"柿,ミカン,柿"と種名の間にカンマを入れたいです。さらにわがままを言わせていただくと、重複を消して"柿,ミカン"と表示できればもっとよいです。
3.そして果実名が複数ある場合には、"確認"が表示される場合と同様に、セルの色を塗りたいです。

いろいろと注文をつけて、申し訳ありません。
もしお時間があれば、よろしくお願いいたします。

回答No.1

tom04

こんばんは！
関数でやるとかなり手間がかかりそうなので・・・
VBAでやってみました。

画面の左下にあるSheet見出しの操作したいSheet名上で右クリック　→　コードの表示　を選択
白い画面が出ますので、↓のコードをコピー＆ペーストしてマクロを実行してみてください。

尚、コード内の「－」や「×」は今一度ご自身で入力し直してみてください。
（「－」の場合はハイフン・マイナス・全ダッシュ等によって結果が変わってきます）

Sub test()
Dim i, j As Long
Dim str, buf As String
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 5
If Cells(i, j) <> "－" And Cells(i, j) <> "×" Then
str = Cells(i, j)
buf = buf & str
End If
Next j
Cells(i, 6) = buf
buf = ""
Next i
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 6) = "" Then
With Cells(i, 6)
.Value = "確認"
.Interior.ColorIndex = 7
End With
End If
Next i
End Sub

尚、一旦マクロを実行すると元に戻せませんので
別Sheetにコピー＆ペーストしてマクロを試してください。

以上、参考になれば良いのですが
もっと簡単な方法があればごめんなさいね。m(__)m