
シート1 シート2
A列 A列
AAA AAA
BBB BBB
CCC DDD
AAA CCC
↓
シート3
A列
AAA
BBB
CCC
DDD
上記のように複数シートに入力されているデータを別のシートに重複なしで抽出するVBAを作りたいので、お知恵を貸して頂きたいです。
VBA初心者ですので、ご迷惑をおかけするとは思いますが、よろしくお願いします。
ちなみに
単一の列を同じシートの列に抽出するVBAはネットで探して成功しました。
それが以下のコードです。
Sub リスト作成()
Dim A As New Collection, i As Long
On Error Resume Next
For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
A.Add Cells(i, 3), Cells(i, 3)
Next i
On Error GoTo 0
For i = 1 To A.Count
Cells(i + 2, 6) = A(i)
Next i
End Sub
No.8ベストアンサー
- 回答日時:
以下のマクロを標準モジュールに登録してください。
Option Explicit
Dim sh3 As Worksheet
Dim dicT As Object
Dim row3 As Long
Public Sub 重複無()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow3 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow3 = sh3.Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行を求める
sh3.Range("B4:B" & maxrow3).ClearContents 'B列4行以降をクリア
row3 = 4
Call シート3出力(sh1)
Call シート3出力(sh2)
MsgBox ("完了")
End Sub
Private Sub シート3出力(ByVal ws As Worksheet)
Dim maxrow As Long
Dim wrow As Long
Dim key As String
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行を求める
For wrow = 3 To maxrow
key = ws.Cells(wrow, "A").Value
If key <> "" Then
If dicT.exists(key) = False Then
dicT(key) = True
sh3.Cells(row3, "B").Value = key
row3 = row3 + 1
End If
End If
Next
End Sub
No.9
- 回答日時:
質問はあくまで重複をなくすことではありますが、実際には重複に絡むデータ列が存在しているとかでは?
とまずは気になりますね。
その重複削除した際にデータを追従させる手段も悩まれてたりはしませんか?
⇒セル範囲の取得法など。
違ってたらスル~して下さいな。
No.6
- 回答日時:
こんにちは
説明にはA列と書いてあって、コードでは3列目(=C列)をいじくっているように見えるけれど、本当のところは何をなさりたいのでしょうか?
>貼り付ける場所がデータ量によって異なりませんか?
VBAなんだから、調べれば良いだけ。
なさりたいことがよくわからないので、勝手に妄想してみました。
(当たるも八卦ですが、A列を集約します)
・「指定シートが存在しない」など、エラーチェックは一切行省いてあります。
Sub Q13000652()
Dim sh As Worksheet, rg As Range
Dim rw As Long, sName
With Worksheets("Sheet3")
.Columns(1).ClearContents
Set rg = .Cells(1, 1)
For Each sName In Array("Sheet1", "Sheet2")
Set sh = Worksheets(sName)
rw = sh.Cells(Rows.Count, 1).End(xlUp).Row
rg.Resize(rw).Value = sh.Cells(1, 1).Resize(rw).Value
Set rg = rg.Offset(rw)
Next sName
.Columns(1).RemoveDuplicates (1)
End With
End Sub
No.5
- 回答日時:
dictionary 重複なし vba
で検索するとサンプル見つかると思いますよ。この用途だとCollectionよりDictionaryの方が分かりやすいです。
頑張って。
No.3
- 回答日時:
質問者さんは勘違いされていますね。
データ範囲もVBAで指定するんですよ。
手作業で範囲を指定するとき、何を基準にデータ範囲と判断するか。
それを明確にしてみましょう。
その判断に基づいて ”プログラムを組む” のです。
No.2
- 回答日時:
自分もコピーして一覧を作ったうえで重複を削除することを薦めます。
それにそのほうが処理が速い。
データ範囲を指定して複製。
Sheet3の1行目に【挿入貼り付け】。
これをSheet1とSheet2の両方で行った後に、
Sheet3で重複削除。
・・・余談・・・
質問文は
「これを作り直せ。オレ様の成果として使ってやるwww」
って内容になっていますが、それで間違いないでしょうか。
ここは自力で問題を解決できるようになるためのアドバイスを受ける場所です。
そのマクロを直す中で何が分からないのかをピンポイントで質問するようにしてみましょう。
例:
「マクロを探してきましたが、解説がないため意味不明です。
どなたか解説をお願いします」
「シートを指定する書き方が分かりません」
など。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
複数シートの複数列に入力され...
-
マクロ実行後に別シートの残像...
-
EXCEL VBA 転記 条件分岐 新...
-
VBA 空白行に転記する
-
グラフマクロで系列を変数にす...
-
VBAでのピボットテーブルの範囲...
-
楽天RSSからエクセルVBAを使用...
-
VBA シート間の転記で、条件の...
-
エクセル VBA 時系列に横一列に...
-
GASでチェックボックスを一括of...
-
Changeイベントで複数セルへの...
-
vlookup&部分一致の文字列のル...
-
100万件越えCSVから条件を満た...
-
Excel UserForm の表示位置
-
ExcelVBAでテキストルーレット...
-
【VBA】写真の貼り付けコードが...
-
Worksheets メソッドは失敗しま...
-
【マクロ】実行時エラー '424':...
-
ExcelVBA修正のお願い
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
マクロ実行後に別シートの残像...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
Count Ifのセルの範囲指定に変...
-
VBA別シートの最終行の次行へ転...
-
楽天RSSからエクセルVBAを使用...
-
100万件越えCSVから条件を満た...
-
VBAで変数の数/変数名を動的に...
-
Changeイベントで複数セルへの...
-
アクセスからエクセルへ出力時...
-
VBAでEXCELから固定長...
-
ExcelのVBマクロを、バックグラ...
-
VBA 別ブックからの転記の高速...
-
Excel VBA オートフィルターで...
-
【VBA】データを各シートに自動...
-
複数シートの複数列に入力され...
-
グラフマクロで系列を変数にす...
-
Unionでの他のシートの参照につ...
-
Excel2013で切り取り禁止
おすすめ情報
回答していただき、ありがとうございます。
その方法は各シートにあらかじめ、データがどのくらい入っているかが分かっていればできると思います。
できれば知識がない人でもボタン1つでできるようにVBAで探しています。
回答していただき、ありがとうございます。
その方法だと、データをコピーして貼り付ける場所がデータ量によって異なりませんか?
また、余談の件ですが私は「分からない問題に対して答えを教えてもらう場所」だと認識しています。
学校であれば、次回からできるようにするが目的かもしれませんが、私はそうではありません。
質問はあくまでも例として挙げさせて頂きました。
実際は
シート1、2はC列の3行目から始まっています。
シート3はB列の4行目から始まっています。
宜しくお願いいたします。