Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

321 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76005】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 11:28 -


	引用なし

	パスワード

▼kanabun さん：
>上をコードにすると、こんな風です。
>
>Sub Test更新1()
>　　Dim A As Worksheet, B As Worksheet
>　　Dim c As Range, r As Range
>　　Dim m
>　　
>　　Set A = Worksheets("SheetA")
>　　Set B = Worksheets("SheetB")
>　　Set r = B.Range("A2", B.Cells(B.Rows.Count, 1).End(xlUp))
>　　For Each c In A.Range("A2", _
>　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
>　　　　m = Application.Match(c, r, 0)
>　　　　If IsNumeric(m) Then
>　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
>　　　　Else
>　　　　　　　　　　　　　　　　　　　'新規データ追加
>　　　　　　A.Rows(c.Row).Copy _
>　　　　　　　B.Cells(B.Rows.Count, 1).End(xlUp).Offset(1)
>　　　　End If
>　　Next
>End Sub

ありがとうございました。
思っていた通りの事ができました。
検証用に、
SheetAに1つの型番(X型番)で10件のデータを用意しました。
追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。
何故4倍なのか???
X型番はSheetBに10件(削除できていない)準備していましたので
50件になりました。

・ツリー全体表示


	【76004】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 11:02 -


	引用なし

	パスワード

▼MARUMO さん：前のと同じですが、追加先セル変数を1つ増やして、記述を簡単にしました。 Sub Test更新2() 　　Dim A As Worksheet, B As Worksheet 　　Dim c As Range, r As Range, q As Range 　　Dim m 　　　　Set A = Worksheets("SheetA") 　　Set B = Worksheets("SheetB") 　　Set q = B.Cells(B.Rows.Count, 1).End(xlUp) '[B]A列最終セル　　Set r = B.Range("A2", q) 　　For Each c In A.Range("A2", _ 　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp)) 　　　　m = Application.Match(c, r, 0) 'SheetB にあるか？　　　　If IsNumeric(m) Then 　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き) 　　　　Else 　　　　　　Set q = q.Offset(1) 　　　　　　A.Rows(c.Row).Copy q　　　'新規データ追加　　　　End If 　　Next End Sub

・ツリー全体表示


	【76003】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 10:49 -


	引用なし

	パスワード

なのでほんとにサンプルのようなデータだった場合（ただし1行目は列見出し）更新後は > 【SheetB】更新後 > A列　B列 C列 D列 E列 F列・・・Z列 > 型番1 7　 7　 7　 7　 7　・・・2014/08/01 > 型番2 5　 5　 5　 5　 5　・・・2014/08/05 > 型番3 8　 8　 8　 8　 8　・・・2014/07/01 > 型番3 2　 2　 2　 2　 2　・・・2013/12/01 > 型番4 7　 7　 7　 7　 7　・・・2014/01/10　 > 型番5 4　 4　 4　 4　 4　・・・2014/08/15　　　　 > 型番6 6　 6　 6　 6　 6　・・・2014/08/01 でなく、以下のようになるはずです。【SheetB】更新後 A列　B列 C列 D列 E列 F列・・・Z列型番1 7　 7　 7　 7　 7　・・・2014/08/01 型番2 5　 5　 5　 5　 5　・・・2014/08/05 型番3 2　 2　 2　 2　 2　・・・2013/12/01 型番4 7　 7　 7　 7　 7　・・・2014/01/10　型番5 4　 4　 4　 4　 4　・・・2014/08/15　　　　型番6 6　 6　 6　 6　 6　・・・2014/08/01

・ツリー全体表示


	【76002】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 10:34 -


	引用なし

	パスワード

（補足）↑ 列見出しのない表は考えられないので、 2行目からがデータ行と仮定して書いています。

・ツリー全体表示


	【76001】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 10:32 -


	引用なし

	パスワード

上をコードにすると、こんな風です。 Sub Test更新1() 　　Dim A As Worksheet, B As Worksheet 　　Dim c As Range, r As Range 　　Dim m 　　　　Set A = Worksheets("SheetA") 　　Set B = Worksheets("SheetB") 　　Set r = B.Range("A2", B.Cells(B.Rows.Count, 1).End(xlUp)) 　　For Each c In A.Range("A2", _ 　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp)) 　　　　m = Application.Match(c, r, 0) 　　　　If IsNumeric(m) Then 　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き) 　　　　Else 　　　　　　　　　　　　　　　　　　　'新規データ追加　　　　　　A.Rows(c.Row).Copy _ 　　　　　　　B.Cells(B.Rows.Count, 1).End(xlUp).Offset(1) 　　　　End If 　　Next End Sub

・ツリー全体表示


	【76000】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 10:29 -


	引用なし

	パスワード

▼MARUMO さん： >1.SheetBに同じ型番がみつかれば、SheetBからすべて削除 >2.SheetAの2行目から最終行までをSheetBの最終行+1 >に貼り付け。更新処理というのはふつうこうやると思います。 If SheetB に同じ型番がみつかれば、SheetBのその行に　　　SheetAデータをその行に上書き（更新） Else　'その型番がみつからなければ　　　　　　SheetBの最終行+1 にデータ追加。 End If --- 行削除は不要です。

・ツリー全体表示


	【75999】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 10:23 -


	引用なし

	パスワード

▼kanabun さん：
>▼MARUMO さん：
>
>>Bに同じ型番が存在すれば、
>>Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。
>>
>>【SheetA】
>>A列　B列 C列 D列 E列 F列・・・Z列
>>型番3 8　 8　 8　 8　 8　・・・2014/07/01
>>型番3 2　 2　 2　 2　 2　・・・2013/12/01
>>型番4 7　 7　 7　 7　 7　・・・2014/01/10　
>>
>>【SheetB】更新前
>>A列　B列 C列 D列 E列 F列・・・Z列
>>型番3 1　 1　 1　 1　 1　・・・2014/08/01←削除してSheetA内容に置き換え
>>型番4 7　 7　 7　 7　 7　・・・2014/08/01←削除してSheetA内容に置き換え　
>
>
>>【SheetB】更新後
>>A列　B列 C列 D列 E列 F列・・・Z列
>>型番3 8　 8　 8　 8　 8　・・・2014/07/01
>>型番3 2　 2　 2　 2　 2　・・・2013/12/01
>>型番4 7　 7　 7　 7　 7　・・・2014/01/10　
>
>サンプルデータおかしくないですか？
>これだと、
>【SheetA】に「型番3」が２つありますね？
>【SheetB】のほうには１つしかないのだから、たとえば Match関数で【SheetB】
>の「型番3」の位置を見つけ、それを
>>【SheetA】
>>型番3 8　 8　 8　 8　 8　・・・2014/07/01　　 …… (1)
>>型番3 2　 2　 2　 2　 2　・・・2013/12/01　　 …… (2)
>(1)番目の行データで置き換えたあと、
>ふたたび Match関数で【SheetB】の「型番3」の位置を見つけ、同じ位置に
>こんどは (2)番目の「型番3」データを上書きする、
>という手順になるから、
>更新後の【SheetB】に「型番3」の行が２つあることはありえません。
>
>それと、日付をみると【SheetB】更新前のほうが更新しようとしている
>【SheetA】の日付より新しいのですが、古い日付データで更新してしまって
>ほんとうにいいのですか？

日付は気にしないでください。（混乱させてしまいました。すみません。）
>【SheetA】に「型番3」が２つありますね？
【SheetA】の方が、多い場合もあります。
単純に、同じ型番があれば1.、2.の処理
無ければ、2.のみ処理を行いたいのですが・・・

1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
2.SheetAの2行目から最終行までをSheetBの最終行+1
に貼り付け。

・ツリー全体表示


	【75998】Re:別シートの値と比較し、削除、追加を...

kanabun - 14/8/18(月) 9:40 -


	引用なし

	パスワード

▼MARUMO さん： >Bに同じ型番が存在すれば、 >Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。 > >【SheetA】 >A列　B列 C列 D列 E列 F列・・・Z列 >型番3 8　 8　 8　 8　 8　・・・2014/07/01 >型番3 2　 2　 2　 2　 2　・・・2013/12/01 >型番4 7　 7　 7　 7　 7　・・・2014/01/10　 > >【SheetB】更新前 >A列　B列 C列 D列 E列 F列・・・Z列 >型番3 1　 1　 1　 1　 1　・・・2014/08/01←削除してSheetA内容に置き換え >型番4 7　 7　 7　 7　 7　・・・2014/08/01←削除してSheetA内容に置き換え　 >【SheetB】更新後 >A列　B列 C列 D列 E列 F列・・・Z列 >型番3 8　 8　 8　 8　 8　・・・2014/07/01 >型番3 2　 2　 2　 2　 2　・・・2013/12/01 >型番4 7　 7　 7　 7　 7　・・・2014/01/10　サンプルデータおかしくないですか？これだと、【SheetA】に「型番3」が２つありますね？【SheetB】のほうには１つしかないのだから、たとえば Match関数で【SheetB】の「型番3」の位置を見つけ、それを >【SheetA】 >型番3 8　 8　 8　 8　 8　・・・2014/07/01　　 …… (1) >型番3 2　 2　 2　 2　 2　・・・2013/12/01　　 …… (2) (1)番目の行データで置き換えたあと、ふたたび Match関数で【SheetB】の「型番3」の位置を見つけ、同じ位置にこんどは (2)番目の「型番3」データを上書きする、という手順になるから、更新後の【SheetB】に「型番3」の行が２つあることはありえません。それと、日付をみると【SheetB】更新前のほうが更新しようとしている【SheetA】の日付より新しいのですが、古い日付データで更新してしまってほんとうにいいのですか？

・ツリー全体表示


	【75997】Re:別シートの値と比較し、削除、追加を...

MARUMO - 14/8/18(月) 9:30 -


	引用なし

	パスワード

▼カエムワセトさん：
>ht tp://www.vbalab.net/bbspolicy.html
>
>>VBA質問箱基本ポリシー
>
>>質問者の方へのお願い
>
>>何をやったか書いてください
>>おそらくあなたは、色々なことを試してできなかった末にここに質問を書くので>しょう。しかし回答者は、あなたが今まで何をやってきたか、何を知っていて何を>知らないかわかりません。今まで試したこと、やろうと思ったけどやり方がわから>なかったことなどをできるだけ詳しく書いてください。

説明不足で申し訳ございません。
以下行削除の処理はできております。
これに行コピーの処理を追加したく、宜しくお願いします。

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim r As Long

Set ws1 = Sheets("SheetB")
Set ws2 = Sheets("SheetA")
lastRow1 = ws1.Range("D" & Rows.Count).End(xlUp).Row
For r = lastRow1 To 2 Step -1
If WorksheetFunction.CountIf(ws2.Columns("A"), ws1.Range("A" & r)) > 0 Then
ws1.Rows(r).Delete
Else
End If
Next

・ツリー全体表示


	【75996】Re:別シートの値と比較し、削除、追加を...

カエムワセト - 14/8/17(日) 22:33 -


	引用なし

	パスワード

ht tp://www.vbalab.net/bbspolicy.html

>VBA質問箱基本ポリシー

>質問者の方へのお願い

>何をやったか書いてください
>おそらくあなたは、色々なことを試してできなかった末にここに質問を書くのでしょう。しかし回答者は、あなたが今まで何をやってきたか、何を知っていて何を知らないかわかりません。今まで試したこと、やろうと思ったけどやり方がわからなかったことなどをできるだけ詳しく書いてください。

・ツリー全体表示


	【75995】別シートの値と比較し、削除、追加を行い...

MARUMO - 14/8/17(日) 22:20 -


	引用なし

	パスワード

VBA 初心者です。宜しくお願いします。シートA,B(同一ファイル内)があり、Bは管理データ。日々発生するAの情報をBへ反映(更新)したい。 A,Bは同じ項目でA列からZ列まであります。（数値、文字、日付含む） A,B双方のA列の型番を比較し(A列の最終行まで)、 Bに同じ型番が存在すれば、 Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。管理台帳.xlsm 【SheetA】 A列　B列 C列 D列 E列 F列・・・Z列型番1 7　 7　 7　 7　 7　・・・2014/08/01 型番2 5　 5　 5　 5　 5　・・・2014/08/05 型番3 8　 8　 8　 8　 8　・・・2014/07/01 型番3 2　 2　 2　 2　 2　・・・2013/12/01 型番4 7　 7　 7　 7　 7　・・・2014/01/10　型番5 4　 4　 4　 4　 4　・・・2014/08/15　　【SheetB】更新前 A列　B列 C列 D列 E列 F列・・・Z列型番1 4　 4　 4　 4　 4　・・・2014/08/01←削除してSheetA内容に置き換え型番2 5　 5　 5　 5　 5　・・・2014/08/01←削除してSheetA内容に置き換え型番3 1　 1　 1　 1　 1　・・・2014/08/01←削除してSheetA内容に置き換え型番4 7　 7　 7　 7　 7　・・・2014/08/01←削除してSheetA内容に置き換え　型番5 4　 4　 4　 4　 4　・・・2014/08/01←削除してSheetA内容に置き換え　型番6 6　 6　 6　 6　 6　・・・2014/08/01←SheetAに型番6は無い為更新なし【SheetB】更新後 A列　B列 C列 D列 E列 F列・・・Z列型番1 7　 7　 7　 7　 7　・・・2014/08/01 型番2 5　 5　 5　 5　 5　・・・2014/08/05 型番3 8　 8　 8　 8　 8　・・・2014/07/01 型番3 2　 2　 2　 2　 2　・・・2013/12/01 型番4 7　 7　 7　 7　 7　・・・2014/01/10　型番5 4　 4　 4　 4　 4　・・・2014/08/15　　　　型番6 6　 6　 6　 6　 6　・・・2014/08/01 どうか、よろしくお願いします。

・ツリー全体表示


	【75994】Re:A列B列シートの文字をみて別シートの...

daisuke - 14/8/15(金) 18:25 -


	引用なし

	パスワード

▼kanabun さん：
γ さんから回答をいただきました。
本当にありがとうございました。

・ツリー全体表示


	【75993】Re:A列B列シートの文字をみて別シートの...

daisuke - 14/8/15(金) 18:23 -


	引用なし

	パスワード

▼γ さん：
ありがとうございます。
何時間もかけていた作業が１秒でおわりました。
本当に助かりました。

・ツリー全体表示


	【75992】Re:A列B列シートの文字をみて別シートの...

γ - 14/8/15(金) 18:13 -


	引用なし

	パスワード

マクロ記録はご存じないのですか？
作業内容がわかっているなら、そのマクロ記録を活かすことができますよ。
下記のコードもそうしたことを元にしています。

すでにkanabunさんから擬似コードの提示がありました。
ですので、蛇足になりますが、
一部にReplaceメソッドにこだわったものを示しておきます。

Sub test2()
　　Dim ws1　　 As Worksheet
　　Dim ws2　　 As Worksheet
　　Dim myRange As Range
　　Dim r　　　 As Range
　　Dim rr　　　As Range
　　Dim repStr　As String
　　Dim p　　　 As Long

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")
　　Set myRange = ws2.Range("C1", ws2.Range("C1").End(xlDown))

　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　repStr = r.Offset(0, 1).Value
　　　　myRange.Replace What:=r.Value, Replacement:=repStr, _
　　　　　　 LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
　　　　　　 SearchFormat:=False, ReplaceFormat:=False
　　Next

　　' 色をつけます。
　　For Each r In ws1.Range("A1", ws1.Range("A1").End(xlDown))
　　　　repStr = r.Offset(0, 1).Value
　　　　For Each rr In myRange
　　　　　　p = InStr(rr.Value, repStr)
　　　　　　If p > 0 Then
　　　　　　　　rr.Characters(Start:=p, Length:=Len(repStr)).Font.Color = -16776961
　　　　　　End If
　　　　Next
　　Next
End Sub

・ツリー全体表示


	【75991】Re:A列B列シートの文字をみて別シートの...

daisuke - 14/8/15(金) 18:04 -


	引用なし

	パスワード

▼kanabun さん：

考えてくださってありがとうございます。
疑似をどうコードにするか全くわからず
申し訳ありません。

・ツリー全体表示


	【75990】Re:A列B列シートの文字をみて別シートの...

daisuke - 14/8/15(金) 18:01 -


	引用なし

	パスワード

▼γ さん：
度々すいません。

シート２のＣ列を選択
↓
ツールバーの検索で記号（例M)を検索
↓
Mを手入力でミカンに置き換え
↓
ミカンの文字をドラッグして赤色つけ
を繰り返しています。

Mが終わったらつぎはR、S・・・・・・。

すごい手間をかけて作業しています。

よろしくお願いします。

・ツリー全体表示


	【75989】Re:A列B列シートの文字をみて別シートの...

γ - 14/8/15(金) 17:48 -


	引用なし

	パスワード

実行したいことは理解しているつもりです。

特に色をつけるところを、どうやっているのか、
具体的に手順を説明してください。
そして、そのマクロ記録を示してください。
サンプル的に一例で構いません。

・ツリー全体表示


	【75988】Re:A列B列シートの文字をみて別シートの...

daisuke - 14/8/15(金) 17:39 -


	引用なし

	パスワード

▼γ さん：
返信ありがとうございます。

先頭とは限らないのです。
私の説明が悪く申し訳ありません。
現状こんな感じです。
セル内（書式文字列）の文字数がバラバラで記号がどの文字位置に入っているか不明です。

シート２のＣ列
◎◎から出荷M予定
◎◎待ちS
R
M取り扱い中止
など

シート１の品目
記号Ａ列（記号はA～GZですがもっと増えていきそうです）Ｂ列に置換したい品目があり目で確認。
シート２のＣ列を手動で検索して置換し、かわった所だけ色を付けてます。

◎◎から出荷M予定
◎◎待ちS
R
M取り扱い中止
など

↓

◎◎から出荷ミカン予定
◎◎待ちスイカ
りんご
ミカン取り扱い中止
など

すべて手作業しています。

お手数をお掛けし申し訳ありません。

・ツリー全体表示


	【75987】Re:A列B列シートの文字をみて別シートの...

kanabun - 14/8/15(金) 17:39 -


	引用なし

	パスワード

▼daisuke さん： >先頭とは限らないのです。 >◎◎から出荷　M 予定 >◎◎待ち　M >M >M取り扱い中止 >などなど > >品目だけ記号（記号はA～GZですがもっと増えていきそうです）でその部分だけ >を変換し変換した文字のみを色を付けたいのです。疑似コードで書くと >　　'---- シート２ >　　With Worksheets(2) >　　　　Set r = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp)) >　　End With >　　For Each c In r 　　あるセルの文字列について　　　　Loopで記号 A～GZがあるか？ InStr関数で調べる　　　　　もしInStr関数が >0 を返したら、　　　　　　その位置から置換文字列で置換する。　　　　　　さらに置換文字列の長さだけFont色を変える　　　　　End If 　　　　Loopおわり　　Next c こうすればよいのでは？

・ツリー全体表示


	【75986】Re:A列B列シートの文字をみて別シートの...

γ - 14/8/15(金) 17:00 -


	引用なし

	パスワード

こんにちは。　　#　外出から戻りました。

>いままで手作業で置換していましたがマクロで効率化したいです。
とのこと。

>M ××　→　みかん　××　部分一致で置換したいのです。
そのケースに関して、どのような手作業をやっていたのか、
回答願います。

日本語で説明したうえで、
マクロ記録のコードをアップしてください。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

321 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free