[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『特定文字を含む行を別シートにコピー・重複データを上書き』(まる)
sheet1にはA~K列(行は不特定)まで情報が入っています(1行目は項目)。
Sheet1のH列に「企業」と入っている行をコピーし、Sheet2の2行目以降に貼り付けをしようと思っています。
Sheet2のフォーマット(列数・項目)はSheet1と一緒です。
貼り付けの際に重複するデータ(行)は上書きするような形にしたいのですが
今のマクロだと重複データも貼り付けされてしまいます。
Sub 訪問データ()
Dim wbRead As Workbook Dim wbOut As Workbook Dim shtRead As Worksheet Dim shtOut As Worksheet
Set wbRead = ActiveWorkbook Set wbOut = Workbooks("あいう.xlsm") Set shtRead = wbOut.Worksheets("sheet1") Set shtOut = wbOut.Worksheets("sheet2")
Dim rng As Range Dim lastRow As Long
For Each shtRead In wbRead.Worksheets For Each rng In shtRead.Range(shtRead.Cells(8, 1), shtRead.Cells(shtRead.Rows.Count, 1).End(xlUp)) 'H列が訪問 If shtRead.Cells(rng.Row, 8) = "訪問" Then shtRead.Rows(rng.Row).Copy
Dim KENSAKU As Variant KENSAKU = shtRead.Range("A:K") Dim FoundCell As Range Set FoundCell = shtOut.Range("A:K").Find(What:=KENSAKU, LookAt:=xlWhole)
If FoundCell Is Nothing Then lastRow = shtOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
shtOut.Rows(lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
Else
shtOut.Rows(FoundCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
End If End If Next rng Next shtRead
Application.CutCopyMode = True ActiveCell.Select
End Sub
間違いが分からないため、ご教示下さい。
< 使用 Excel:Excel2010、使用 OS:Windows8 >
> KENSAKU = shtRead.Range("A:K") > Set FoundCell = shtOut.Range("A:K").Find(What:=KENSAKU, LookAt:=xlWhole) この部分がよく判りません。 元シート全部を先シート全部から探す…。変ですよね? 今調べている行は rng で判るので、その行にあるどれかの情報を出力先から探しましょう。 (???) 2018/10/19(金) 16:20
検索してヒットしたマクロを拾って当てはめたので、マクロの意味?が分かっていない状況です。
???さんがから指摘していただいたマクロの意味がわからないのでどこが変かわかりませんでした…。
(まる) 2018/10/19(金) 16:40
1)sheet1のH列が「企業」をオートフィルタ
2)sheet2に転記
3)「重複の削除」実行
4)オートフィルタ解除
(マナ) 2018/10/19(金) 19:04
1)Sheet2のデータをsheet1のデータの下に転記
2)フィルタオプションで、H列が「企業」の行を重複なしでsheet2に転記
3)1)で転記したデータをクリア
(マナ) 2018/10/19(金) 20:17
フィルターで作業をするのではなく、不特定多数の方が使うシートなので、
ボタンをクリックする作業で済ませたいです><
(まる) 2018/10/22(月) 13:21
やりたいことと違う事をコーディングしても思った通りに動く訳がないです。 まずは H:H セルから「企業」を探すように書き換えてみてください。(KENSAKUしたいのは "企業" なのでしょう?)
(???) 2018/10/22(月) 14:07
>貼り付けの際に重複するデータ(行)は上書きするような形にしたいのですが >今のマクロだと重複データも貼り付けされてしまいます。 この「重複するデータ」とは具体的に何が何に対しての重複でしょう?
(seiya) 2018/10/22(月) 14:48
シート1もデータも他ブックから抽出した情報を反映させています。
抽出ボタンを押すと自動でブックから拾ってくるようになっているのですが、こちらも同様にボタンを押すたびに元データの1行目から反映されてしまいます~~;
(まる) 2018/10/22(月) 14:58
だけど、H列が「訪問」なのだとして、それって沢山の行に同じ文字列がありませんか? 同じ行なら上書き、を実現するならば、探すべきなのは、ユニークな文字列にしないと駄目ですよ。
(???) 2018/10/22(月) 15:05
ループ開始する前に既存ののデータをクリアる。
ということですか?
shtOut.Cells(1).CurrentRegion.Offset(1).Clear
とか? (seiya) 2018/10/22(月) 15:13
>データを重複がないように追記させていきたいです。 これがよくわからいのですよね...
具体的に例を挙げて説明してもらった方が理解しやすいと思いますが? (seiya) 2018/10/22(月) 15:27
他ブックより転記すると例えばこのようなデータが抽出されたとします。
〜シート1〜
A B C D E F G H I J K 1 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 2 abc def ghi jkl mno pqr stu wxy zab cde fgh 3 zyx uts rqp mno jkl ihg fed cba aba bcb cdc 4 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde
H列で「訪問」と入力されている行をシート2へ抽出します。
〜シート2〜
A B C D E F G H I J K 1 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 2 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde 3 4
===================================
★シート1に新しいデータが更新され、以下のデータになったとします。
〜シート1〜
A B C D E F G H I J K 1 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 2 abc def ghi jkl mno pqr stu wxy zab cde fgh 3 zyx uts rqp mno jkl ihg fed cba aba bcb cdc 4 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde 5 lll mmm nnn ooo ppp qqq rrr 訪問 ttt uuu www
H列で「訪問」と入力されている行をシート2へ抽出します。
〜シート2〜
A B C D E F G H I J K 1 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 2 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde 3 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 4 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde 5 lll mmm nnn ooo ppp qqq rrr 訪問 ttt uuu www
となってしまいます><
3・4行目が1・2行目と重複してしまいます。
これを
〜シート2〜
A B C D E F G H I J K 1 aaa bbb ccc ddd eee fff ggg 訪問 iii jjj kkk 2 aaa bbb ccc fff ggg aba aab 訪問 bbc ccd dde 3 lll mmm nnn ooo ppp qqq rrr 訪問 ttt uuu www 4 5
とするにはどうすればいいのでしょうか?
(まる) 2018/10/22(月) 15:45
こういうことですか?
Sub test() Dim ws1 As Worksheet, ws2 As Worksheet, x Set ws1 = Sheets("sheet1") Set ws2 = Sheets("sheet2") With ws1.Cells(1).CurrentRegion .Parent.AutoFilterMode = False .AutoFilter 8, "訪問" .Offset(1).Copy ws2.Range("a" & Rows.Count).End(xlUp)(2) .AutoFilter End With With ws2.Cells(1).CurrentRegion x = Evaluate("column(" & .Rows(1).Address & ")") ReDim Preserve x(0 To UBound(x) - 1) .RemoveDuplicates (x), 1 End With End Sub (seiya) 2018/10/22(月) 16:01
思った通りのこができました!
ありがとうございます。
重複行をチェックし、削除するコードはどの部分になりますか?
他のコードにもくっつけてみたいのですが・・・
(まる) 2018/10/22(月) 16:11
With ws2.Cells(1).CurrentRegion x = Evaluate("column(" & .Rows(1).Address & ")") ReDim Preserve x(0 To UBound(x) - 1) .RemoveDuplicates (x), 1 End With
ここで全列が重複している行を削除しています。 (seiya) 2018/10/22(月) 16:16
> .Offset(1).Copy ws2.Range("a" & Rows.Count).End(xlUp)(2) を
.Offset(1).Copy ws2.Range("a" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues の2行に変更して下さい。 (seiya) 2018/10/22(月) 17:08
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.