- ベストアンサー
ExcelVBAでデータ不一致のものの抽出
単純なものにしたいので教えてください。 Sheet1「元データ」 A B C D コード 商品 店名 納入日 1 0001 みかん A店 3/1 5 0360 メロン D店 6 かき P店 7 0312 キウイ D店 9 0333 くり C店 Sheet2「最新データ」 A B C D コード 商品 店名 納入日 1 0001 みかん A店 3/1 4 0311 いちご B店 3/10 6 0250 8 0312 キウイ とあった時に元データのA列の番号と最新データの番号を見て同じ物があったら、元データに最新データの内容をうつし込み、一致しなかったらチェックデータへうつしこむというデータがあります。 Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim Sh3 As Worksheet Dim myR As Range Dim N_D As Long Dim i As Long Set Sh1 = Worksheets("元データ") Set Sh2 = Worksheets("チェックデータ") Set Sh3 = Worksheets("最新データ") With Sh1 For i = 5 To .Range("A65536").End(xlUp).Row N_D = .Range("E" & i).Value Set myR = Sh3.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _ MatchCase:=False) If Not myR Is Nothing Then myR.Offset(, 2).Resize(, 3).Copy _ Destination:=.Range("B" & i & ":D" & i) Else addR_No = Sh2.Range("A65536").End(xlUp).Row + 1 .Range("A" & i & ":D" & i).Copy _ Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No) End If Next End With ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに内容を書き込むとする場合はどのように修正すればよいのでしょうか?あと、チェックデータのあたまに コード 商品 店名 納入日 という言葉を入れたいのですが、どのように書き込むのでしょうか?
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
- ベストアンサー
![noname#29107](https://gazo.okwave.jp/okwave/images/contents/av_nophoto_100_3.gif)
その他の回答 (1)
- imogasi
- ベストアンサー率27% (4737/17068)
関連するQ&A
- ExcelVBAでデータ不一致のものの抽出
Sheet1「元データ」 A B C D 1 0001 みかん A店 3/1 2 0200 りんご B店 3 0311 いちご B店 3/10 4 いちじく C店 5 0360 メロン D店 6 かき P店 7 0312 キウイ D店 99 0333 くり C店 Sheet2「最新データ」 A B C D 1 0001 みかん A店 3/1 2 0190 3 0200 4 0311 いちご B店 3/10 5 0422 洋ナシ C店 6 0250 7 0500 すいか P店 8 0312 キウイ とあった時に最新データのA列の番号と元データの番号を見て同じ物があったら、最新データに元データの内容をうつし込むというデータがあります。 Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim Sh3 As Worksheet Dim myR As Range Dim N_D As Long Dim i As Long Set Sh1 = Worksheets("元データ") Set Sh2 = Worksheets("新規データ") Set Sh3 = Worksheets("最新データ") With Sh3 For i = 5 To .Range("A65536").End(xlUp).Row N_D = .Range("E" & i).Value Set myR = Sh1.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _ MatchCase:=False) If Not myR Is Nothing Then myR.Offset(, 2).Resize(, 3).Copy _ Destination:=.Range("B" & i & ":D" & i) End If Next End With Set Sh1 = Nothing Set Sh2= Nothing Set Sh3 = Nothing ここで、もし、最新データA列の番号と元データの番号を見て一致しないもの、元データにしかないものや最新データにしかないものがあったら、新規データとして、別シートに行ごと書き写したい場合はどのようにすれば良いのでしょうか?
- ベストアンサー
- オフィス系ソフト
- ExcelVBAマクロでのデータの受け渡し
Sheet1「元データ」 A B C D 1 0001 みかん A店 3/1 2 0200 りんご B店 3 0311 いちご B店 3/10 4 いちじく C店 5 0360 メロン D店 6 かき P店 7 0312 キウイ D店 Sheet2「最新データ」 A B C D 1 0001 みかん A店 3/1 2 0190 3 0200 4 0311 いちご B店 3/10 5 0422 洋ナシ C店 6 0250 7 0500 すいか P店 8 0312 キウイ とあった時に最新データのA列の番号と元データの番号を見て同じ物があったら、最新データに元データの内容をうつし込むというデータがあります。 Dim Sh1 As Worksheet Dim Sh3 As Worksheet Dim myR As Range Dim N_D As Long Dim i As Long Set Sh1 = Worksheets("元データ") Set Sh3 = Worksheets("最新データ") With Sh3 For i = 5 To .Range("A65536").End(xlUp).Row N_D = .Range("E" & i).Value Set myR = Sh1.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _ MatchCase:=False) If Not myR Is Nothing Then .Range("B" & i & ":D" & i).Value = _ myR.Offset(, 2).Resize(, 3).Value End If Next End With Set Sh1 = Nothing Set Sh3 = Nothing ここで、値は普通にコピーされてくるのですが、 フォントに色がついていたら、その色もつけたいのですが、どうすれば良いのか分らず困っています。 方法がありましたら、教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- このマクロの意味を教えてください。
このマクロの意味を教えてください。 このマクロの意味を教えてくれませんか?変な質問で申し訳ありません。というのも、先日インターネットからひろってそのままま真似して使っていたのですが、不具合が起こってしまいました。 しかし、どこからひろったのかどう検索しても見つからず、自分で不具合の原因がわからないのです。 どなたか、教えていただけないでしょうか。 このひとつひとつのマクロの意味を教えていただけたら大変助かります。 Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("元データ") Set sh2 = Worksheets("RMA") '-- d = sh1.Range("a65536").End(xlUp).Row For i = 2 To d If sh1.Cells(i - 1, "E") <> "" Then sh2.Cells(1, "A") = i - 1 sh2.Range("A2:I51").PrintOut End If Next i End Sub
- ベストアンサー
- Visual Basic
- エクセルVBA抽出がうまく出来ません
エクセル2013VBA初心者です。 入力シートからDBシートへ、DBシートから印刷シートへのデータ転記と印刷、入力内容のクリアまでは出来るようになりました。 DBシートの検索を行い、記録内容を入力シートに転記する抽出を行いたいのですが、下記構文を書いたところで問題が発生しました。 If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then でとまります。メッセージは ‘Range’メソッドは失敗しました:‘Workshieet’オブジェクトというものです。 やろうとしていることは、入力シートに設けた“E12”と”G12”の二つの検索項目をキーにDBシートの行を特定し、この行の内容を入力シートに反映しようということです。 入力シートの検索項目“E12”、 ”G12”はそれぞれDBシートのA列、B列に格納されている項目で、年度と連番です。サンプルとして入力シート"C5"に抽出しようとしているDBシートD列は申請者名です。 恐れ入りますがよろしくご教示頂きたく、お願い申し上げます。 Sub DBシートから力情報を抽出する () Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim i As Long Dim j As Long Dim k As Long Set Sh1 = Worksheets("入力") Set Sh2 = Worksheets("DB") j = Sh1.Range("E12").Value k = Sh1.Range("G12").Value With Sh2 For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then Sh1.Range("C5").Value = Sh2.Range("D & i").Value End If Next End With End Sub
- ベストアンサー
- Excel(エクセル)
- ロートルの初心者です、VBAについての質問です。
エクセル2003で以下のVBAを色々な資料を基に、「テスト2」のシートに条件検索されたデータ、マクロ起動(?)で「入力履歴」に追記されるものを作成しました。 Sub prog() Dim myFld As String, myCri As String Dim myRow As Long Dim Sh2 As Worksheet, Sh3 As Worksheet Set Sh2 = Worksheets("テスト2") Set Sh3 = Worksheets("入力履歴") With Sh2 myRow = .Range("D" & Rows.Count).End(xlUp).Row Range("A1:H" & myRow).Copy Destination:=Sh3.Range("A" & Rows.Count).End(xlUp).Offset(1) End With Sh3.Activate Range("A1").Select End Sub ここで問題となるのが抽出データには関数が含まれているため「入力履歴」シートに書き込まれたデータにもそのまま貼り付けられるので「#A/N」となってしまいます。 Range("A1:H" & myRow).Copy Destination:=Sh3.Range("A" & Rows.Count).End(xlUp).Offset(1)の 「Destination」を変えれば良いかと思ったのですが・・・、うまくいきません。 エクセルでいう、「形式を選択して貼り付け→値」をやりたいのですが書き方がわかりません。 ロートルの初心者によろしく愛の手をお願い申します。 PS:説明文があると助かります。
- ベストアンサー
- オフィス系ソフト
- Excel VBA元データから別シートへ振り分け
元データ(DB)をA列の値で振り分け 別シート(印刷)に転記していく方法について教えてください。 以下のコードで転記は行えましたが1つの値で1つのシートを作成になってしまいます。 どこをどのように変更すればA列の値(一種類に1つのシートにまとめたい)に 1つのシートに転記となるかご教示お願いします。 Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("DB") Set sh2 = Worksheets("印刷") d = sh1.Range("A65536").End(xlUp).Row For i = 2 To d sh2.Cells(6, "B") = sh1.Cells(i, "A") sh2.Cells(10, "B") = sh1.Cells(i, "B") sh2.Cells(10, "C") = sh1.Cells(i, "C") sh2.Cells(10, "D") = sh1.Cells(i, "D") sh2.Cells(10, "E") = sh1.Cells(i, "E") sh2.Cells(10, "F") = sh1.Cells(i, "F") sh2.Cells(10, "G") = sh1.Cells(i, "G") sh2.Cells(10, "H") = sh1.Cells(i, "H") sh2.Cells(10, "J") = sh1.Cells(i, "I") 'sh2.Range("a1:J34").PrintOut Next i End Sub よろしくお願いいたします。
- ベストアンサー
- Excel(エクセル)
- エクセルVBAで実行時エラー 91 が出ます
エクセル2000です 各部署の棚卸を纏める為のVBAを作成しているのですが、実行時にエラーになってしまいます エラーメッセージは 「実行時エラー 91 オブジェクト変数またはWithブロック変数が設定されていません」 です ご教授お願いいたします Sub 棚卸() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("在庫集計票") Set sh2 = Worksheets("棚卸表") x = sh2.Range("A65536").End(xlUp).Row Z = sh1.Range("d2").Value ’部署番号 sh1.Range(Cells(5, Z), Cells(3000, Z)).ClearContents For i = 2 To x y = sh1.Range("A2:A" & Range("A2").End(xlDown).Row). _ Find(sh2.Cells(i, "a")).Row ’ここでエラーが発生します sh1.Cells(y, Z) = sh2.Cells(i, "c") Next i End Sub
- ベストアンサー
- オフィス系ソフト
- どなたかマクロ修正お願いします。
自分なりに 作成してみましたがどうもうまくいきません。 Sub 変換() Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Dim r As Range Set Sh1 = Worksheets("1") Set Sh2 = Worksheets("2") Set Sh3 = Worksheets("3") Sh3.Select Set c = Cells.Find(What:="9876543", LookAt:=xlWhole) c.Offset(, 1).Activate ActiveCell.Replace What:="中田", Replacement:="中田英寿" End Sub このように作成しましたがうまくいきません。恐らくsheet3のデータはsheet1から( =1!A100 )といったように値を他のsheetから持ってきてるからではないんでしょうか?
- ベストアンサー
- オフィス系ソフト
- 行すべての値を張り付けるようにするには
次の突合用マクロですが、照合番号だけでなく行すべてのデータを張り付けたいのですが、どの部分に変更を加えればよいかわかりません。 (添付画像をご覧ください) ・Sheet3~6にも列B~以降のデータを張り付けたい EntireRow Copy を使おうとしたのですが、どの様に行を指定すればよいかわかりませんでした。 ご教示頂ければ幸いです。 【準備して頂いたマクロ】 Sub TestX() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim Sh3 As Worksheet, Sh4 As Worksheet Dim Sh5 As Worksheet, Sh6 As Worksheet Dim Sh1data As Variant, Sh2data As Variant Dim Sh3data As Variant, Sh4data As Variant Dim Sh5data As Variant, Sh6data As Variant Dim Sh1LastRow As Long, Sh2LastRow As Long Dim i As Long, j As Long, Sh5flg As Boolean Set Sh1 = Worksheets("Sheet1") Set Sh2 = Worksheets("Sheet2") Set Sh3 = Worksheets("Sheet3") Set Sh4 = Worksheets("Sheet4") Set Sh5 = Worksheets("Sheet5") Set Sh6 = Worksheets("Sheet6") ReDim Sh3data(0) ReDim Sh4data(0) ReDim Sh5data(0) ReDim Sh6data(0) Sh1LastRow = Sh1.Cells(Rows.Count, "A").End(xlUp).Row Sh2LastRow = Sh2.Cells(Rows.Count, "A").End(xlUp).Row Sh1data = Sh1.Range(Sh1.Cells(3, "A"), Sh1.Cells(Sh1LastRow, "B")).Value Sh2data = Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Sh2LastRow, "B")).Value For i = 1 To Sh1LastRow - 2 Sh5flg = False For j = 1 To Sh2LastRow - 2 If Sh1data(i, 1) = Sh2data(j, 1) Then If Sh2data(j, 2) <> "◯" Then Sh1data(i, 2) = "◯" Sh3data(UBound(Sh3data)) = Sh1data(i, 1) ReDim Preserve Sh3data(UBound(Sh3data) + 1) Sh2data(j, 2) = "◯" Else Sh5data(UBound(Sh5data)) = Sh1data(i, 1) ReDim Preserve Sh5data(UBound(Sh5data) + 1) Sh5flg = True End If Exit For End If Next j If Sh1data(i, 2) <> "◯" And Sh5flg = False Then Sh5data(UBound(Sh5data)) = Sh1data(i, 1) ReDim Preserve Sh5data(UBound(Sh5data) + 1) End If Next i For i = 1 To Sh2LastRow - 2 If Sh2data(i, 2) = "◯" Then Sh4data(UBound(Sh4data)) = Sh2data(i, 1) ReDim Preserve Sh4data(UBound(Sh4data) + 1) Else Sh6data(UBound(Sh6data)) = Sh2data(i, 1) ReDim Preserve Sh6data(UBound(Sh6data) + 1) End If Next Sh1.Range("A3").Resize(Sh1LastRow - 2, 2).Value = Sh1data Sh2.Range("A3").Resize(Sh2LastRow - 2, 2).Value = Sh2data Sh3.Range("A3").Resize(UBound(Sh3data), 1).Value = WorksheetFunction.Transpose(Sh3data) Sh4.Range("A3").Resize(UBound(Sh4data), 1).Value = WorksheetFunction.Transpose(Sh4data) Sh5.Range("A3").Resize(UBound(Sh5data), 1).Value = WorksheetFunction.Transpose(Sh5data) Sh6.Range("A3").Resize(UBound(Sh6data), 1).Value = WorksheetFunction.Transpose(Sh6data) Set Sh1 = Nothing Set Sh2 = Nothing Set Sh3 = Nothing Set Sh4 = Nothing Set Sh5 = Nothing Set Sh6 = Nothing End Sub
- ベストアンサー
- Excel(エクセル)
- 式を残して値のみ削除
Sub clear() Dim wskyu As Worksheet Dim wsData As Worksheet Dim Y As Range Const SH_KYUYO As String = "給与明細" Const SH_DATA As String = "データ入力" Set wskyu = Worksheets(SH_KYUYO) Set wsData = Worksheets(SH_DATA) With wsData For Each Y In .Range("C3:G55") If Y.Interior.ColorIndex <> xlNone Then Y.ClearContents End If Next End With With wskyu Range ("P7:AQ7"), .Range("D10:AQ10"), .Range("D13:AQ13"), _ .Range("D17:AQ17"), .Range("D20:AQ20"), .Range("D24:AQ24"), _ .Range("D29:AI29").Select Selection.SpecialCells(xlCellTypeConstants, 23).Select Selection.ClearContents End With MsgBox "個人番号を入力後、性別を選択しボタン(1)を押してください" End Sub 値のみ削除しようと上のコードを書いたのですが With wskyu のあとの Range~ でプロパティの使い方が不正です と言われてしまいました(-_-;) ヘルプボタンがあったので押しても空のページに飛んでしまい どうすればよいのかわかりません、、、 どうかよろしくおねがいします!!
- ベストアンサー
- Visual Basic
- 服やズボンを何回も洗うとヨレヨレになったり、傷むことがあります。その原因は、洗濯の段階にあります。洗濯機で洗濯する際の最初の水に浸る段階や次の洗われる段階、すすぎの段階、脱水の段階のどこかで繰り返し洗濯することが原因です。
- 洗濯で服やズボンがヨレヨレになる原因は、洗濯の段階にあります。洗濯機で洗濯する際の最初の水に浸る段階や洗われる段階、すすぎの段階、脱水の段階のいずれかで繰り返し洗濯することが原因です。
- 服やズボンを何回も洗うとヨレヨレになったり、傷むことがあります。この原因は、洗濯の段階にあります。洗濯機で洗濯する際の最初の水に浸る段階や洗われる段階、すすぎの段階、脱水の段階のどれかで繰り返し洗濯することが原因です。
お礼
なるほど!Notをとることで普通にIf文になるからすすめれるわけですね。 通常元データを中心にして考えるんでしょうが、今回は毎月最新データを中心にして考えて元データを作るというにしてます。 実際のデータは大量にあるので、大分進んできて楽しくなってきました。また細かい所で質問させていただきますのでよろしくお願いします。