こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBAでピポットテーブルを作成していたらエラーがでて解決できません。

こんばんは。
ExcelVBAで重複していないデータのみをSheet2に転記させたいのですが、どうしたらよいのでしょうか。
A行に重複するデータが入っいます。
A列の重複しないデータとB列に入っている名前を転記してマスタを作りたいと考えています。

A    B    
12345  りんごA
12346  みかんB
12347  いちごC
12346  みかんB

宜しくお願い致します。

投稿日時 - 2009-08-19 22:53:10

QNo.5220931

困ってます

質問者が選んだベストアンサー

重複するデータ「12346 みかんB」を一つ記載するのか全く記載しないのか迷いましたが、一つ記載することで作ってみました。

(1)以下(マクロ)をモジュールに貼り付けます。
(2)データがあるシート名を「Sheet1」((1)部分),データを転記するシート名を「Sheet2」((2)部分)として作成していますので、必ず2つのシート名と(1)、(2)部分を完全に一致させてください。
(3)あとはマクロを実行してください。(ツール→マクロ→マクロ→「まとめ」を選択→実行)

Sub まとめ()
Dim i As Long, k As Long, r As Range, s As Worksheet, s1 As Worksheet
Set s = Sheets("Sheet1") '(1)
Set s1 = Sheets("Sheet2") '(2)
s.Select: s1.Cells.Clear
k = 1
For i = 1 To s.Range("A" & Rows.Count).End(xlUp).Row
If Not s.Cells(i, 1).Value = "" Then
Set r = s.Columns(1).Find(what:=s.Cells(i, 1).Value, after:=s.Cells(i, 1), lookat:=1, searchdirection:=xlPrevious)
If r.Row >= i Then
s1.Range("A" & k).Value = s.Cells(i, 1).Value
s1.Range("B" & k).Value = s.Cells(i, 2).Value
End If
End If
k = s1.Range("A" & Rows.Count).End(xlUp).Row + 1
Next
s1.Select: MsgBox "全てまとめ終わりました。"
End Sub

投稿日時 - 2009-08-20 05:54:08

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問