人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセル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

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

●質問者: taroemon
●カテゴリ:コンピュータ
✍キーワード:VBA 「東京」 けが にの ひとつ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●80ポイント

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

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
◎質問者からの返答

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

ちゃんとできました。


2 ● きゃづみぃ
●80ポイント
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

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

◎質問者からの返答

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ