指定した条件で行セルを非表示にするVBAについて

いつもお世話になっております。

この度、指定した条件でchat-GPTに助言を求めたところ、下記のVBAを提示していただいたのですが、重複している行セルが非表示になってくれず困っております。

指定条件は、例えばD列に重複している文字列が入力されており、かつE列にPCの文字が入力されている場合、その重複している行セルを非表示にする処理を構築したいのですが

' D列の重複文字列とE列の含む"PC"をチェックし、行セルを非表示にする
For i = 10 To lastRow
Dim cellD As String
Dim cellE As String
cellD = ActiveSheet.Cells(i, 4).Value
cellE = ActiveSheet.Cells(i, 5).Value

If Not dictD.Exists(cellD) Then
dictD(cellD) = 1
Else
dictD(cellD) = dictD(cellD) + 1
End If

If InStr(1, cellE, "PC", vbTextCompare) > 0 Then
If Not dictE.Exists(cellD) Then
dictE(cellD) = 1
Else
dictE(cellD) = dictE(cellD) + 1
End If
End If

If dictD(cellD) > 1 And dictE(cellD) = 1 Then
ActiveSheet.Rows(i).EntireRow.Hidden = True
End If
Next i

こちらのVBAを実行したところ、PCが入力されている行セルだけが非表示となり、Surfaceが入力されている行セルは表示されたままとなります。
この重複している行セルを非表示にすることは可能なのでしょうか？

よろしくお願いいたします。

質問者からの補足コメント

• 早速のご返答に重ねVBAの構築ありがとうございます！
  
  重ね重ね申し訳ございません。
  実行したところ、添付しました画像の形の処理となったのですが
  こちらの12行目の重複しておりますPC(東芝)の行セルも非表示にしたい処理になります。
  重ねてPCの文字列は部分一致の*PC*としております。
  PCが重複しております10、11行目は表示したままにできたのでありがとうございます。
  
  よろしくお願いいたします。

  
  No.5の回答に寄せられた補足コメントです。 補足日時：2023/10/18 13:40

• 重ね重ね、申し訳ございません。
  
  No.7で構築してくださいましたVBAの自動化の処理が楽しくなり、昨夜色々とExcel表を触っていたのですが、その際、フィルターがかけられている際にどうも処理が反映されないことに気がつき補足にて返信させていただきました。
  
  フィルターは9行目に位置しております。
  例えば、D列の重複セルでのフィルターや他のセルの発送依頼日の日付でのフィルターがかけられていると処理が反映されず、フィルターを解除すると処理は問題なく反映されるので、おそらくフィルターが原因だと思われます。
  フィルターがかけられている状態でも処理が反映がされることは可能でございますでしょうか？
  
  お手数をおかけし申し訳ございません。
  重ね重ね、よろしくお願いいたします。

  No.11の回答に寄せられた補足コメントです。 補足日時：2023/10/19 06:43

No.7 回答者： fujillin 回答日時： 2023/10/18 18:40

No3です。

ご自分で修正する気が無いのなら、初めからきちんと表現すべきです。
同じことを繰り返し考えるのは無駄手間です。

以下は、
・Ｄ列の値に重複があり
・そのＥ列の値のいずれかに「PC」の文字が含まれていて
・そのＥ列の値全てには「PC」の文字が含まれてはいない
という条件を全て満たす場合に、該当する行を非表示にする例です。

Sub Sample3()
Dim r, n
Const f = "=IF((COUNTIF(D:D,D1)>1)*"
Const g = "(COUNTIFS(D:D,D1,E:E,""*PC*"")<>COUNTIF(D:D,D1))"
Const h = "*(COUNTIFS(D:D,D1,E:E,""*PC*"")>0),"""",1)"

n = Cells(Rows.Count, 4).End(xlUp).Row
Set r = Cells(1, Columns.Count).Resize(n)
r.Formula = f & g & h
r.Value = r.Value
If Application.CountBlank(r) > 0 Then _
r.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
r.EntireColumn.Delete
End Sub

この回答へのお礼

No3様の仰る通りです。
申し訳ございません。

重ねてお詫び申し上げます。
構築していただいた処理を実行したところ
D列重複行セルのEセルにPCを含む文字列だけが入力されている行セルも非表示となります。
この重複行セルは表示させたく、実現したい処理内容はNo.5様の回答に補足させていただきました形になります。

お手を煩わせてしまい、申し訳ございません。
よろしくお願いいたします。

お礼日時：2023/10/18 19:06

No.6 回答者： tatsumaru77 回答日時： 2023/10/18 15:00

>こちらの12行目の重複しておりますPC(東芝)の行セルも非表示にしたい処理になります。

D列の重複行のうち、E列にPCの文字を含んでいる行が2つ以上あった場合は、その行を表示すると理解しました。
（D列の重複行のうち、E列にPCの文字を含んでいる行が１行のみの場合は、その行も非表示にする）
上記で、合ってますでしょうか。

根本的に処理を見直す必要があるので、改修に時間がかかります。
改修は夕方以降になるかと思いますのご了承ください。

この回答へのお礼

ありがとうございます。
私の言葉足らずで申し訳ございません。

処理内容を今一度整理しますと、
①D列の重複行のうち、そのEセル上にPCの文字だけを含んでいる行セルは表示。

②D列の重複行のうち、そのEセル上にPCの文字を含んではいるが、PC以外の文字が入力されている場合は、その重複行セルは非表示にする処理としたいです。

よろしくお願いいたします。

お礼日時：2023/10/18 18:18

No.5 回答者： tatsumaru77 回答日時： 2023/10/18 13:12

>重複行セルでかつPCだけが入力されている重複行セルは表示したままの分岐処理することは可能でしょうか？

こういうことでしょうか？
重複行のうち、E列にPCを含んでいる文字があれば、その行は表示します。

Public Sub 非表示()
Dim wrow As Long
Dim ws As Worksheet
Dim dicROW As Object
Dim dicPC As Object
Dim dicROWPC As Object
Dim maxrow As Long
Dim key As Variant
Dim cellE As String
Dim elms As Variant
Dim i As Long
Set ws = ActiveSheet
ws.Cells.EntireRow.Hidden = False
maxrow = ws.Cells(rows.Count, "D").End(xlUp).Row
Set dicROW = CreateObject("Scripting.Dictionary")
Set dicPC = CreateObject("Scripting.Dictionary")
Set dicROWPC = CreateObject("Scripting.Dictionary")

For wrow = 10 To maxrow
key = ws.Cells(wrow, "D").Value
cellE = ws.Cells(wrow, "E").Value
If dicROW.exists(key) = False Then
dicROW(key) = wrow
dicPC(key) = False
Else
dicROW(key) = dicROW(key) & "," & wrow
End If
If InStr(1, cellE, "PC", vbTextCompare) > 0 Then
dicPC(key) = True
dicROWPC(wrow) = True
End If
Next
For Each key In dicROW.keys
If dicPC(key) = True Then
elms = Split(dicROW(key), ",")
If UBound(elms) >= 1 Then
For i = 0 To UBound(elms)
wrow = CLng(elms(i))
If dicROWPC.exists(wrow) = False Then
ws.rows(elms(i)).Hidden = True
End If
Next
End If
End If
Next
End Sub

この回答へのお礼

早速のご返答に重ねVBAの構築ありがとうございます！
補足したのですが、画像添付に審査がつくことになったのですね。

文章にて失礼します。

10.　20231017 PC(sony)
11.　20231017 PC(sony)
12.　20231018 PC(東芝)
13.　20231018 surface

13行目が非表示になりましたが、12行目が非表示になりません。
こちらの12行目の重複しておりますPC(東芝)の行セルも非表示にしたい処理になります。
最初に構築してくださいましたVBAでは12、13行目の重複行セルが非表示になり、この状態で10、11行目のPCが入力されている行セルは非表示にしない処理は可能でしょうか。
重ねてPCの文字列は部分一致の*PC*としております。

よろしくお願いいたします。

お礼日時：2023/10/18 14:23

No.4 回答者： tatsumaru77 回答日時： 2023/10/18 11:53

No1です。

補足要求（前提の確認）のつもりで投稿したのですが、補足がありませんでしたので、全てNo1の前提で、マクロを作成しました。
いかのようにしてください。

Public Sub 非表示()
Dim wrow As Long
Dim ws As Worksheet
Dim dicROW As Object
Dim dicPC As Object
Dim maxrow As Long
Dim key As Variant
Dim cellE As String
Dim elms As Variant
Dim i As Long
Set ws = ActiveSheet
ws.Cells.EntireRow.Hidden = False
maxrow = ws.Cells(rows.Count, "D").End(xlUp).Row
Set dicROW = CreateObject("Scripting.Dictionary")
Set dicPC = CreateObject("Scripting.Dictionary")

For wrow = 10 To maxrow
key = ws.Cells(wrow, "D").Value
cellE = ws.Cells(wrow, "E").Value
If dicROW.exists(key) = False Then
dicROW(key) = wrow
dicPC(key) = False
Else
dicROW(key) = dicROW(key) & "," & wrow
End If
If InStr(1, cellE, "PC", vbTextCompare) > 0 Then
dicPC(key) = True
End If
Next
For Each key In dicROW.keys
If dicPC(key) = True Then
elms = Split(dicROW(key), ",")
If UBound(elms) >= 1 Then
For i = 0 To UBound(elms)
ws.rows(elms(i)).Hidden = True
Next
End If
End If
Next
End Sub

この回答へのお礼

No.1様、VBAの構築ありがとうございます！
ご返答が遅くなり申し訳ございません。

条件に一致する重複行セルを非表示にすることができました！
ありがとうございます。
重ね重ねお手数をおかけし申し訳ございませんが、重複行セルでかつPCだけが入力されている重複行セルは表示したままの分岐処理することは可能でしょうか？

よろしくお願いいたします。

お礼日時：2023/10/18 12:49

No.3 回答者： fujillin 回答日時： 2023/10/17 15:22

No2です

＞重複していないセルデータにPCが入力されている行セルも非表示になってしまい
「重複していること」を条件に加えておくのを忘れてました。すみません。

修正するなら、こんな感じで。

Sub Sample2()
Dim r, n
n = Cells(Rows.Count, 4).End(xlUp).Row
Set r = Cells(1, Columns.Count).Resize(n)
r.Formula = "=IF((COUNTIF(D:D,D1)>1)*COUNTIFS(D:D,D1,E:E,""PC""),"""",1)"
r.Value = r.Value
If Application.CountBlank(r) > 0 Then _
r.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
r.EntireColumn.Delete
End Sub

この回答へのお礼

修正ありがとうございます！
重ね重ねごめんなさい、あともうちょっとです。

重複データのE列にPCだけが入力されている場合は重複行セルを表示する処理も追加していただきたくよろしくお願いいたします。

お礼日時：2023/10/17 16:05

No.2 回答者： fujillin 回答日時： 2023/10/17 12:54

こんにちは

ご説明がイマイチよくわからないけれど、ひょっとしてこんなことでしょうか？

Sub Sample()
Dim r, n
n = Cells(Rows.Count, 4).End(xlUp).Row
Set r = Cells(1, Columns.Count).Resize(n)
r.Formula = "=IF(COUNTIFS(D:D,D1,E:E,""PC""),"""",1)"
r.Value = r.Value
If Application.CountBlank(r) > 0 Then _
r.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
r.EntireColumn.Delete
End Sub


※ 勝手に想像していますので、違っている場合はスルーしてください。

この回答へのお礼

No.2様、VBAの構築ありがとうございます。
行セルを非表示にすることができました！
重ねてお手数をおかけし申し訳ございませんがお願いがございます。

重複していないセルデータにPCが入力されている行セルも非表示になってしまい、並びに重複している行セルにPCが入力されている場合は行セルは非表示にしない処理をよろしくお願いいたします。

お礼日時：2023/10/17 14:31

No.1 回答者： tatsumaru77 回答日時： 2023/10/17 07:27

例でいうと、黄色のセルが非表示の対象になる行でしょうか。

緑のセルは、非表示にならない。

E列はPCの文字が含まれていれば良い。（OPC,PC,XPCA等）
PCは半角でも全角でも大文字でも小文字でも良い。