エクセルVBAについて質問です。


「1」と「2」と「3」という名前のシート以外の
全てのシート内のN列に記入されている文字列の中で、
重複されているものだけを「0」という名前のシートのA列に
記入するというマクロを作ってください。

ただし、重複された文字列はいくつあっても、
ひとつだけがA列に記入されるということにご留意ください。

(例)
ケース①
「4」「8」「77」の各シートのN列に、
20個づつ「東京」という言葉が入っている場合・・・、

ケース②
「8」「14」という各シートのN列に、
ひとつずつ「大阪」という言葉か入っている場合・・・、

ケース③
全ブックの中で「6」というシートのN列にひとつだけしか、
「名古屋」という文字がない場合・・・、

シート「0」にのA列には「東京」「大阪」の文字列が
ひとつずつ記入されるということです。
(注)「名古屋」は重複していないので記入されません。

なお下記のページで似たような質問をしているので参考にしてください。
http://q.hatena.ne.jp/1194925557

以上、よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2007/11/13 18:52:46
  • 終了:2007/11/13 23:58:40

回答(2件)

id:SALINGER No.1

SALINGER回答回数3430ベストアンサー獲得回数9692007/11/13 19:35:57

ポイント80pt

かなり変数が入り組んでいるので見づらいですが、やっていることはセル一つづつ比較して同じのをカウントして

2個以上ならばシート”0”に無いことを確認して書き込むです。

他の方法として、シート”0”に先に全部のデータを書き込んでソートして目的に合わないデータを削除とかならスマートかもしれませんね。それは他の人に任せます。

Sub Macro()
    k = 1
    For Each ws1 In Worksheets
        If ws1.Name <> "0" And ws1.Name <> "1" And ws1.Name <> "2" And ws1.Name <> "3" 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 <> "0" And ws2.Name <> "1" And ws2.Name <> "2" And ws2.Name <> "3" 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("0").Cells(l, 1).Value = st Then
                                bl = True
                            End If
                        Next l
                        If bl = False Then
                            Worksheets("0").Cells(k, 1).Value = st
                            k = k + 1
                        End If
                    End If
                End If
            Next i
        End If
    Next
End Sub
id:taroemon

いつもご回答ありがとうございます。

ちゃんとできました。

2007/11/13 23:54:19
id:taknt No.2

きゃづみぃ回答回数13481ベストアンサー獲得回数11982007/11/13 20:34:16

ポイント80pt
Sub Macro1()

For a = 1 To Worksheets.Count
    b = Worksheets(a).Name
    If Not (b = "0" Or b = "1" Or b = "2" Or b = "3") 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 = "0" Or b1 = "1" Or b1 = "2" Or b1 = "3") 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("0").Range("A65536").End(xlUp).Row To 1 Step -1
                                    If d = Worksheets("0").Cells(f, "A") Then
                                        g = 2
                                        Exit For
                                    End If
                                Next f
                                If g = 1 Then
                                    h = Worksheets("0").Range("A65536").End(xlUp).Row
                                    If Worksheets("0").Cells(h, "A") = "" Then
                                        Worksheets("0").Cells(h, "A") = d
                                    Else
                                        Worksheets("0").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

けっこう階層が深くなってわかりにくいプログラムになっちゃいました。

id:taroemon

いつもありがとうございます。

深くなってしまったのは質問のせいですね。

2007/11/13 23:55:34

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません