「１」と「２」と「３」という名前のシート以外の
全てのシート内のN列に記入されている文字列の中で、
重複されているものだけを「０」という名前のシートのA列に
記入するというマクロを作ってください。
ただし、重複された文字列はいくつあっても、
ひとつだけがA列に記入されるということにご留意ください。
（例）
ケース①
「４」「８」「７７」の各シートのN列に、
２０個づつ「東京」という言葉が入っている場合・・・、
ケース②
「８」「１４」という各シートのN列に、
ひとつずつ「大阪」という言葉か入っている場合・・・、
ケース③
全ブックの中で「６」というシートのN列にひとつだけしか、
「名古屋」という文字がない場合・・・、
シート「０」にのA列には「東京」「大阪」の文字列が
ひとつずつ記入されるということです。
（注）「名古屋」は重複していないので記入されません。
なお下記のページで似たような質問をしているので参考にしてください。
http://q.hatena.ne.jp/1194925557
以上、よろしくお願いします。
No.1
3454
969
80pt
かなり変数が入り組んでいるので見づらいですが、やっていることはセル一つづつ比較して同じのをカウントして
２個以上ならばシート”０”に無いことを確認して書き込むです。
他の方法として、シート”０”に先に全部のデータを書き込んでソートして目的に合わないデータを削除とかならスマートかもしれませんね。それは他の人に任せます。
668
631
Sub Macro()
k = 1
For Each ws1 In Worksheets
If ws1.Name <> "０" And ws1.Name <> "１" And ws1.Name <> "２" And ws1.Name <> "３" Then
For i = 1 To ws1.Range("N65536").End(xlUp).Row
st = ws1.Range("N" & i).Value
If st <> "" Then
ct = 0
bl = False
For Each ws2 In Worksheets
If ws2.Name <> "０" And ws2.Name <> "１" And ws2.Name <> "２" And ws2.Name <> "３" Then
For j = 1 To ws2.Range("N65536").End(xlUp).Row
If ws2.Range("N" & j).Value = st Then
ct = ct + 1
End If
Next j
End If
Next
If ct > 1 Then
For l = 1 To k - 1
If Worksheets("０").Cells(l, 1).Value = st Then
bl = True
End If
Next l
If bl = False Then
Worksheets("０").Cells(k, 1).Value = st
k = k + 1
End If
End If
End If
Next i
End If
Next
End Sub
No.2
135391198
80pt
Sub Macro1() For a = 1 To Worksheets.Count b = Worksheets(a).Name If Not (b = "０" Or b = "１" Or b = "２" Or b = "３") Then For c = Worksheets(a).Range("N65536").End(xlUp).Row To 1 Step -1 d = Worksheets(a).Cells(c, "N") If d <> "" Then Worksheets(a).Cells(c, "N") = "" For e = 1 To Worksheets.Count b1 = Worksheets(e).Name If Not (b = "０" Or b1 = "１" Or b1 = "２" Or b1 = "３") Then For c1 = Worksheets(e).Range("N65536").End(xlUp).Row To 1 Step -1 If d = Worksheets(e).Cells(c1, "N") Then g = 1 For f = Worksheets("０").Range("A65536").End(xlUp).Row To 1 Step -1 If d = Worksheets("０").Cells(f, "A") Then g = 2 Exit For End If Next f If g = 1 Then h = Worksheets("０").Range("A65536").End(xlUp).Row If Worksheets("０").Cells(h, "A") = "" Then Worksheets("０").Cells(h, "A") = d Else Worksheets("０").Cells(h + 1, "A") = d Exit For End If End If End If Next c1 End If Next e Worksheets(a).Cells(c, "N") = d End If Next c End If Next a End Sub
けっこう階層が深くなってわかりにくいプログラムになっちゃいました。
いつもありがとうございます。
深くなってしまったのは質問のせいですね。
1
1
2
1
いつもご回答ありがとうございます。
ちゃんとできました。