[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複データの削除及びコピー貼り付け』（まさこ）
このような、ことをやりたいと思いまして聞きがじりながら作成しました。どうしてもうまくいかずに困ってしまいました。よい良い方法がありましたらご教授願えませんか。よろしくお願いします。
このようなデータがあります。
sheet１ A3:A500 sheet２ A2:A100
処理したいこと
１．sheet３ A2:A500 A501:A600 重複を削除したら５００件ほどになる予定
(sheet１のデータA2:A500の後にsheet２の１００件ほどA501:A600 に入れることを前提に考えています。)
２．sheet４ C2〜のデータについて
sheet３で重複したデータの整理されたものが、sheet４のA2〜に入る sheet４のA2〜に入れば、事前に作成済みのC列に関数で１つ空きのデータになります。
３．sheet５ C3〜の場所
sheet４のC列のデータをsheet５C列にコピペできて完成
(データの数は上限で示しています。)
Sample3()
sheet１のデータをsheet３にコピペする
sheet２のデータをsheet３にコピペする
Worksheets("Sheet1").Range("A3:A500").Copy Worksheets("Sheet3").Range("A2:A500")
Worksheets("Sheet2").Range("A2:A100").Copy Worksheets("Sheet3").Range("A501:A600")
End Sub
Sample1() 重複データの削除及びコピー貼り付け
sheet３の重複データの削除をする (重複を削除したら５００件ほどになる予定)
Range(Cells(3, 2), Cells(16, 2)).RemoveDuplicates _
Columns:=Array(1), Header:=xlYes
sheet３の重複データの削除したものをsheet４にコピペする (重複を削除したら５００件ほどになる予定)
sheet４のデータをsheet５にコピペする
Worksheets("Sheet3").Range("A2:A500").Copy Worksheets("Sheet4").Range("A2:A500")
Worksheets("Sheet4").Range("C2:C500").Copy Worksheets("Sheet5").Range("C3:C500")
End Sub
これから先が、聞きかじりで作ったマクロです
sample()
e1 = Sheets("Sheet1").UsedRange.Row
e2 = Sheets("Sheet2").UsedRange.Row
Set sht1L = Sheets("Sheet1").Range("A1").SpecialCells(xlCellTypeLastCell)
Set sht2L = Sheets("Sheet2").Range("A1").SpecialCells(xlCellTypeLastCell)
Set sht4 = Sheets("Sheet4")
Set sht5 = Sheets("Sheet5")
saki = Range(Sheets("Sheet1").Range("A3"), sht1L).Value
atto = Range(Sheets("Sheet2").Range("A2"), sht2L).Value
sakiD = UBound(saki)
sakiR = UBound(saki, 2)
attoD = UBound(atto)
attoR = UBound(atto, 2)
migi = -(sakiR > attoR) * sakiD - (akiR <= attoR) * attoR
Range(sht4.Cells(3, 1), sht4.Cells(sakiD + 2, sakiR)).Value = _
saki
Range(sht4.Cells(sakiD + 3, 1), sht4.Cells(sakiD + 2 + attoD, attoR)).Value = _
atto
Range(sht4.Cells(3, 1), sht4.Cells(sakiD + 2 + attoD, migi)).RemoveDuplicates _
Columns:=1, Header:=xlNo
Range(sht5.Cells(3, 3), sht5.Cells(sakiD + 2 + attoD, 3)).Value = _
Range(sht4.Cells(3, 3), sht4.Cells(sakiD + 2 + attoD, 3)).Value
End Sub
最終的に、sheet１のデータがsheet４に列だけでなく、全て出てしまっています。sheet４で重複データをsheet５に移すデータになっていません。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
(1) Sheet1のA3:A500、Sheet2のA2:A100 それぞれに重複ありのデータが入っていて (2) Sheet3は重複データ削除の作業用シート (3) Sheet4のC列に、A列のデータをどうにかする数式がはいっていて、(2)の処理をしたあとのデータ群をA列に貼付 (4) Sheet5のC列に、(3)の処理後（Sheet4のC列）のデータを値貼付したい
必要な命令は分かっておられるようですので、順番に処理していけばゴールにたどり着けそうですが。。。
未テストですが、整理するとこんな感じではないでしょうか
Sub さんぷる()
Dim buf As Range
Stop
With Worksheets("Sheet3")
'Sheet3全体をクリア
.Cells.Clear
'Sheet3へデータをあつめる
Worksheets("Sheet1").Range("A3:A500").Copy .Range("A1")
Worksheets("Sheet2").Range("A2:A100").Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
'集めたデータから重複を削除
.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
'重複削除後のデータ（セル範囲）を「buf」に格納
Set buf = .Range("A1", .Cells(.Rows.ount, "A").End(xlUp))
End With
With Worksheets("Sheet4")
'A2セル以下をクリア
.Range("A2", .Cells(.Rows.Count, "A")).ClearContents
'Sheet3のデータをA2セル以下に貼付
buf.Copy .Range("A2")
'C列のデータ（セル範囲）を「buf」に格納
Set buf = .Range("C2", Cells(.Rows.ount, "A").End(xlUp).Offset(, 2))
End With
With Worksheets("Sheet5")
'A2セル以下をクリア
.Range("C2", .Cells(.Rows.Count, "C")).ClearContents
'値貼付（PasteSpecialでもよいが、このような方法もアリかも）
.Range("C2").Resize(buf.Rows.Count, buf.Columns.Count).Value = buf.Value
End With
End Sub
とりあえず、ご自身のコードにインデント付け直して見やすくしてから、
ステップ実行してみてどこがマズいのか調べるところから手を付けてみてはいかがでしょうか。
（もこな２） 2019/01/17(木) 14:00
衝突しましたが、せっかくなので なんとなくですけど、無理やり配列を使おうとして混乱していらっしゃる気がします。 こちらのコードで少し考えを整理していませんか？ わからないことがあれば質問してください。
Sub sample()
Dim data As Variant 'データコピー用の使いまわし配列
'Sheet3〜5のA列をリセット
Sheets("Sheet3").Range("A2:A" & Rows.Count).ClearContents
Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents
Sheets("Sheet5").Range("A2:A" & Rows.Count).ClearContents
'Sheet1のデータをSheet3にコピー
With Sheets("Sheet1")
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet2のデータをSheet3にコピー
With Sheets("Sheet2")
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet3の重複データを削除して、Sheet4にコピー
With Sheets("Sheet3")
.Range("A1", .Cells(Rows.Count, "A").End(xlUp)).RemoveDuplicates 1, xlYes
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
With Sheets("Sheet4")
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet4のC列をSheet5にコピー
data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
Sheets("Sheet5").Range("A2").Resize(UBound(data)).Value = data
End Sub
（稲葉） 2019/01/17(木) 14:18
稲葉さん、何とかできそうです、ありがとうございます。
但し、次のところがエラーになります。
.Range("A1", .Cells(Rows.Count, "A").End(xlUp)).RemoveDuplicates 1, xlYes
なぜでしようか。
お教え頂きながら、申し上げにくいのですが、
それと、sheet３の結果が、A１が空欄になり、A2からデータがはいります。
さらに、sheet４のA2〜に転記されません。
当然のことながら、sheet５にも転記されません。
sheet４のC2からsheet５は、C3から転記できませんでした。
(sheet５は３行セルの真ん中に転記のデータが入ります、これは、sheet４のC列は関数で処理した番号ができます)
更に、どうでしょうか、こんなことができるのでしょうか。
sheet１・sheet２にA列は番号なのです。
sheet２はA列〜J列にデータがあり、J列のそれぞれのセルに高・低・否の文字が入っています。
それで、低・否だけを抽出して、そのA列の番号だけをsheet３に転記できればよりよいのですが、難しいですよね。
すみません、よければそこまで、お教え頂ければ幸いです。
（まさこ） 2019/01/17(木) 20:55
最初提示されたコードでは ＞Range(Cells(3, 2), Cells(16, 2)).RemoveDuplicates _ Columns:=Array(1), Header:=xlYes で、A1にヘッダーがあRange(Cells(3, 2), Cells(16, 2)).RemoveDuplicates _ Columns:=Array(1), Header:=xlYesる想定でした なので、A2からデータを張り付けました 厳密に言うと、A列の最終行でCtrl+↑を押して、止まったセルの一つ下のセルに張り付けています
いずれにしろ、どういうデータが入っているのか不明なので、表の構成、データ、結果を教えてください
（稲葉） 2019/01/17(木) 21:29
また、sheet４のC列はA列から、関数でこのような行に配列されるように既に設定しています。
そして、sheet４のC２の空欄のデータからsheet５のC３へそのまま転記されればよいことになります。
sheet3 A列 B列 C列 1 番号 以下空欄 以下空欄 2 K00023 3 K00253 4 K01256 5 K15021 6 K13562 7 K00020 8 K06850 9 K05312 10 K00003 11 K00055 12 K00250
sheet4 ソートされ昇順に A列 B列 C列 1 番号 以下空欄 2 K00023 3 K00253 K00023 4 K01256 5 K15021 6 K13562 K00253 7 K00020 8 K06850 9 K05312 K01256 10 K00003 11 K00055 12 K00250 K15021 （まさこ） 2019/01/17(木) 22:34
シート4のC列が、昇順に見えないのですが、、、 K00003 K00020 この二つに限りませんが、どこへ？ その計算式も提示お願いします （稲葉） 2019/01/17(木) 22:51
まず、それはエラーが発生しているのではありません。
「STOPステートメント」といって、そこでマクロの実行を一時停止させる命令が書いてあるため止まったのです。
要は、ブレークポイントの代わりです。
【ブレークポイントとは】
http://kabu-macro.com/word/ha-ho/breakpoint.html
そして、改めて申し上げれば、参考にされる場合「STOP」のところで止まるようにしたので、一度ステップ実行して動きを確認して、必要な部分だけご自身のコードに組み込んでください。
【ステップ実行とは】
https://www.239-programing.com/excel-vba/basic/basic023.html
また、ソートの話がでてきましたけど、それなら普通に並び替えを実行しましょう。
頑張れば配列でもなんとかできるかもですが、難易度が上がるだけで得策ではないようにおもいます。
【並び替え】
http://officetanaka.net/excel/vba/tips/tips148.htm
このほか、Sheet4のイメージがわかりませんが、A2以下の値を、C3以下に、2セル飛ばしで出力してるってことですかね？
もしそうであれば、
Sub てすと壱()
Dim i As Long
With Worksheets("Sheet4")
.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy Range("C3")
For i = .Cells(.Rows.Count, "C").End(xlUp).Row To 3 Step -1
.Cells(i, "C").Resize(2).Insert Shift:=xlDown
Next i
End With
End Sub
とか
Sub てすと弐()
Dim i As Long
With Worksheets("Sheet4")
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells((i - 1) * 3, "C").Value = .Cells(i, "A").Value
Next i
End With
End Sub
みたいな感じでしょうかね。
（もこな２） 2019/01/17(木) 23:47
C=IF(L3<>"",INDEX(A$2:A$2000,MATCH(1,INDEX((J$2:J$2000=L3)*(N$2:N$2000=COUNTIF(L$3:L3,L3)),0),0)),"")
D=IFERROR(IF(MOD(ROW(A1),3)=1,INDEX(B$2:B$12,MATCH(SMALL(E$2:E$12,INT(ROW(A1)/3)+1),E$2:E$12,0)),""),"")
E=IFERROR(IF(COUNTIF(B$2:B2,B2)=1,MAX(E$1:E1)+1,VLOOKUP(B2,B$2:E2,4,FALSE)),"")
F=IF(E2="","",COUNTIFS(E$2:E$12,E2,A$2:A$12,"<"&A2)+1)
なお、A列・C列が必要で後のE列・F列はこれを導く確認や補助的なものです。
更に、C列の後半の各行の間隔が狭くなって見えると思いますが、前半と同じように開けていますが、表示されていません。考慮下さいませんか。
sheet4
A B C D E F
1 番号 高低否
2 K00003 高 1 1
3 K00020 低 K00003 高 2 1
4 K00023 高 1 2
5 K00055 否 3 1
6 K00250 低 K00023 高 2 2
7 K00253 高 1 3
8 K01256 高 1 4
9 K05312 高 K00253 高 1 5
10 K06850 否 3 2
11 K13562 低 2 3
12 K15021 低 K01256 高 2 4
K05312 高
K00020 低
K00250 低
K13562 低
> 但し、sheet４はソートされ昇順になっていませんが、ならなくてはいけない訳です。 前のところで、急いでいて、理をしておりました。申し訳ありません。昇順を遅れて示すことお詫びします。
（はなこ） 2019/01/18(金) 09:50
＞但し、Stopがエラーになりますが、なぜでしょうか。
ちゃんとかいてなかったですね。失礼しました。
（はなこ） 2019/01/18(金) 09:59
>sheet２はA列〜J列にデータがあり、J列のそれぞれのセルに高・低・否の文字が入っています。
>それで、低・否だけを抽出して、そのA列の番号だけをsheet３に転記できればよりよいのですが、難しいですよね。
１．sheet２の高だけを削除してsheet１との合算のデータは難しいでしょか。
その後で重複データを削除する。
２．また、高と否だけを削除したsheet２データの低だけのデータをsheet１と合算する。その後重複データを削除する。
１．２．のどちらかができないでしょうか。
Sub sample2()
Dim data As Variant 'データコピー用の使いまわし配列
'Sheet3〜5のA列をリセット
Sheets("Sheet3").Range("A1:A" & Rows.Count).ClearContents
Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents
Sheets("Sheet5").Range("C3:C" & Rows.Count).ClearContents
'Sheet1のデータをSheet3にコピー
With Sheets("Sheet1")
data = .Range("A3", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet2のデータをSheet3にコピー
With Sheets("Sheet2")
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet3の重複データを削除して、Sheet4にコピー
With Sheets("Sheet3")
.Range("A1", .Cells(Rows.Count, "A").End(xlUp)).RemoveDuplicates 1, xlYes
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
With Sheets("Sheet4")
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(data)).Value = data
'Sheet4のC列をSheet5にコピー
data = .Range("C2:C" & .Cells(Rows.Count, "C").End(xlUp).Row).Value
End With
Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data
End Sub
（はなこ） 2019/01/18(金) 14:57
要件の整理します。 １）Sheet2のJ列が「低」のA列の番号を取得します。 ２）１）とSheet1のA列の重複しないデータを作ります。 ３）２）をSheet4のA列に書き出します。 ４）Sheet4のC列（計算式）をSheet5のC列に書き出します。
でよろしいですか？ ちなみに、合算とは合計を指すと思いますが、今回はデータを組み合わせると解釈しました。
＞ >それで、低・否だけを抽出して、そのA列の番号だけをsheet３に転記できればよりよいのですが、難しいですよね。
と
＞２．また、高と否だけを削除したsheet２データの低だけのデータをsheet１と合算する。その後重複データを削除する。 が矛盾していますが、後者を採用します。
Sub sample2()
Dim data As Variant 'データコピー用の使いまわし配列
Dim dic As Object
Dim i As Long
Set dic = CreateObject("Scripting.Dictionary")
'Sheet4〜5のA列をリセット
Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents
Sheets("Sheet5").Range("C3:C" & Rows.Count).ClearContents
'Sheet2のデータdataに取込
With Sheets("Sheet2")
data = .Range("J2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
'Sheet2のJ列で「低」のみdicに取込
For i = 1 To UBound(data) 'J＝10列目
If data(i, 10) = "低" Then
dic(data(i, 1)) = ""
End If
Next i
'Sheet1のデータをdataに取込
With Sheets("Sheet1")
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
End With
'Sheet2に重複していないデータのみdicに取込
For i = 1 To UBound(data) 'J＝10列目
dic(data(i, 1)) = ""
Next i
'Sheet3は不要
'Sheet4に重複していないデータを書き込み
With Sheets("Sheet4")
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value = Application.Transpose(dic.keys)
'Sheet4のC列をSheet5にコピー
data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data
Set dic = Nothing
End Sub
（稲葉） 2019/01/18(金) 16:06
data = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Value
data = .Range("A3", .Cells(Rows.Count, "A").End(xlUp)).Value
"A2"を"A3"に変更しました
data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
data = .Range("C2:C" & .Cells(Rows.Count, "C").End(xlUp).Row).Value
"A"に"C"変更に変更しました
上記のように変更してできました。
なお、'Sheet4に重複していないデータを書き込みはできているのですが、A列のソートができないのですが、どうしたらよいでしようか。
（はなこ） 2019/01/19(土) 12:52
（まさこ） 2019/01/17(木) 22:34 の投稿で ＞sheet4 ソートされ昇順に は、C列を指していると解釈しました。
ソートは自分で記録を取ってみてください。
（稲葉） 2019/01/19(土) 13:02
どこに、どのように入れたらよいでしようか。動いてくれないので、教えて頂けませんか。
また、A列の入力されているデータの最終セル("A1:A1135")への変更の仕方がわかりませんが、どのようにしたらよいでしょうか。
ご教授下さいませんか。よろしくお願いします。
Sub Sample7()
A列を基準に昇順で並べ替えます
Sheets("sheet4").Range("A1:A1135").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
End Sub
（まさこ） 2019/01/19(土) 22:42
の投稿で ＞厳密に言うと、A列の最終行でCtrl+↑を押して、止まったセルの一つ下のセルに張り付けています と申し上げました
その部分が最終行を求めるコードですので、自分で入れてみて、 どうかいたら、どのような結果になったのか教えていただければ こちらで修正方法提示できます
あと少しですので、最後は頑張りましょう （稲葉） 2019/01/20(日) 05:52
下記のように、sheet４の途中にいれてみましたが、違うでしょうか。
現在、Excel２００３しか手元になく、結果をためすにも、明日以降でないとためすことができません。すみません。申し訳ないです。
但し、Sheets("sheet4").Range("A1:A1135").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
これではできています。
'Sheet4に重複していないデータを書き込み
With Sheets("Sheet4")
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value = Application.Transpose(dic.keys)
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
'Sheet4のC列をSheet5にコピー
data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data
Set dic = Nothing
End Sub
（まさこ） 2019/01/20(日) 15:12
＞Sheets("sheet4").Range("A1:A1135").
この範囲をとりたいわけですよね？
手持ちのエクセルで構いませんので、新しいブックのシートのA列になにかデータを入れて
イミディエイトウィンドウで
Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Address
で結果を見てください
なにが違うかわかると思います
私が今まで提示したなかにヒントがありますので、ゆっくりでいいので 最後は自分で頑張ってみてください
（稲葉） 2019/01/20(日) 15:33
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value =Application.Transpose(dic.keys)
'Sheet4のA列を昇順にソート
.Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
（まさこ） 2019/01/21(月) 00:23
私は.DictionaryObjectを人に説明できるほど詳しくないので、的を外してるかもですけど、
メモリ上にあるまま（出力する前に）keyでソートって掛けられませんでしたっけ？
どうせDictionaryObject使うなら、並び替えてから出力すればいいんじゃないかと思っただけなんですが。。。
（もこな２） 2019/01/21(月) 04:25
もこなさん ArrayListと記憶違いじゃないですか？ https://qiita.com/daik/items/682743bb8bcd8b5f0689
まさこさん、できてよかったですね！ 便利な書き方なので、ぜひ他のコードでも使い倒してください
（稲葉） 2019/01/21(月) 06:04
はなこさんへ
トピ汚し失礼しました。
参考に、DictionaryObjectを使って重複しないリストを作成する方法について説明しているサイトのリンク置いておきます。
http://officetanaka.net/excel/vba/tips/tips80.htm
（もこな２） 2019/01/22(火) 11:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.