[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複データの削除及びコピー貼り付け』(まさこ)
このような、ことをやりたいと思いまして聞きがじりながら作成しました。どうしてもうまくいかずに困ってしまいました。よい良い方法がありましたらご教授願えませんか。よろしくお願いします。
このようなデータがあります。
sheet1 A3:A500 sheet2 A2:A100
処理したいこと
1.sheet3 A2:A500 A501:A600 重複を削除したら500件ほどになる予定
(sheet1のデータA2:A500の後にsheet2の100件ほどA501:A600 に入れることを前提に考えています。)
2.sheet4 C2〜のデータについて
sheet3で重複したデータの整理されたものが、sheet4のA2〜に入る sheet4のA2〜に入れば、事前に作成済みのC列に関数で1つ空きのデータになります。
3.sheet5 C3〜の場所
sheet4のC列のデータをsheet5C列にコピペできて完成
(データの数は上限で示しています。)
Sample3()
sheet1のデータをsheet3にコピペする
sheet2のデータをsheet3にコピペする
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() 重複データの削除及びコピー貼り付け
sheet3の重複データの削除をする (重複を削除したら500件ほどになる予定)
Range(Cells(3, 2), Cells(16, 2)).RemoveDuplicates _
Columns:=Array(1), Header:=xlYes
sheet3の重複データの削除したものをsheet4にコピペする (重複を削除したら500件ほどになる予定)
sheet4のデータをsheet5にコピペする
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
最終的に、sheet1のデータがsheet4に列だけでなく、全て出てしまっています。sheet4で重複データをsheet5に移すデータになっていません。
< 使用 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
とりあえず、ご自身のコードにインデント付け直して見やすくしてから、
ステップ実行してみてどこがマズいのか調べるところから手を付けてみてはいかがでしょうか。
(もこな2) 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
なぜでしようか。
お教え頂きながら、申し上げにくいのですが、
それと、sheet3の結果が、A1が空欄になり、A2からデータがはいります。
さらに、sheet4のA2〜に転記されません。
当然のことながら、sheet5にも転記されません。
sheet4のC2からsheet5は、C3から転記できませんでした。
(sheet5は3行セルの真ん中に転記のデータが入ります、これは、sheet4のC列は関数で処理した番号ができます)
更に、どうでしょうか、こんなことができるのでしょうか。
sheet1・sheet2にA列は番号なのです。
sheet2はA列〜J列にデータがあり、J列のそれぞれのセルに高・低・否の文字が入っています。
それで、低・否だけを抽出して、そのA列の番号だけをsheet3に転記できればよりよいのですが、難しいですよね。
すみません、よければそこまで、お教え頂ければ幸いです。
(まさこ) 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
また、sheet4のC列はA列から、関数でこのような行に配列されるように既に設定しています。
そして、sheet4のC2の空欄のデータからsheet5のC3へそのまま転記されればよいことになります。
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
みたいな感じでしょうかね。
(もこな2) 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 低
> 但し、sheet4はソートされ昇順になっていませんが、ならなくてはいけない訳です。 前のところで、急いでいて、理をしておりました。申し訳ありません。昇順を遅れて示すことお詫びします。
(はなこ) 2019/01/18(金) 09:50
>但し、Stopがエラーになりますが、なぜでしょうか。
ちゃんとかいてなかったですね。失礼しました。
(はなこ) 2019/01/18(金) 09:59
>sheet2はA列〜J列にデータがあり、J列のそれぞれのセルに高・低・否の文字が入っています。
>それで、低・否だけを抽出して、そのA列の番号だけをsheet3に転記できればよりよいのですが、難しいですよね。
1.sheet2の高だけを削除してsheet1との合算のデータは難しいでしょか。
その後で重複データを削除する。
2.また、高と否だけを削除したsheet2データの低だけのデータをsheet1と合算する。その後重複データを削除する。
1.2.のどちらかができないでしょうか。
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
要件の整理します。 1)Sheet2のJ列が「低」のA列の番号を取得します。 2)1)とSheet1のA列の重複しないデータを作ります。 3)2)をSheet4のA列に書き出します。 4)Sheet4のC列(計算式)をSheet5のC列に書き出します。
でよろしいですか? ちなみに、合算とは合計を指すと思いますが、今回はデータを組み合わせると解釈しました。
> >それで、低・否だけを抽出して、そのA列の番号だけをsheet3に転記できればよりよいのですが、難しいですよね。
と
>2.また、高と否だけを削除したsheet2データの低だけのデータをsheet1と合算する。その後重複データを削除する。 が矛盾していますが、後者を採用します。
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
下記のように、sheet4の途中にいれてみましたが、違うでしょうか。
現在、Excel2003しか手元になく、結果をためすにも、明日以降でないとためすことができません。すみません。申し訳ないです。
但し、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使うなら、並び替えてから出力すればいいんじゃないかと思っただけなんですが。。。
(もこな2) 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
(もこな2) 2019/01/22(火) 11:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.