Results of 1 - 1 of about 27304 for マクロ (0.014 sec.)
- [[20180403165201]]
- #score: 2167
- @digest: cdcfdd7871f647059524855ed772a7e9
- @id: 75993
- @mdate: 2018-04-21T01:47:43Z
- @size: 55960
- @type: text/plain
- #keywords: ～～ (128598), frng (74714), 月デ (25009), めシ (21418), 列] (17978), シー (16461), ロブ (13622), ート (13321), ト4 (12347), ト1 (12113), ブッ (12049), ト2 (11042), タ入 (10610), 目名 (10596), タシ (9755), ト3 (9363), 転記 (7843), デー (7735), 最新 (6805), ータ (6747), ク名 (6720), 重複 (6651), 省略 (5881), 2018 (5812), ック (5740), モジ (5691), ジュ (5439), 更新 (5186), 格納 (4753), 上書 (4697), ピペ (4654), マク (4396)
- 『マクロのIF文が思いつかない』（きれいこさん）
はじめまして。 下記のようなIF文を作りたいのですが どなたかヒントを頂けないでしょうか。 日本語をIF文にしたいです。 Dim i For i = 2 To Cells(Rows.Count, 1).End(xup).Row If A=B then もしシート1のA列とシート2のA列が同じだったら 処理1 シート2のAEとAFをシート1のBPとBSに貼り付ける elseif A=C then もしシート1のA列とシート2のA列が同じでシート1のA列にシート2のA列と同じものが複数あったら 処理2 シート2のAEとAFを、シート1のBPとBSにA列で該当している分だけ貼り付ける else もし検索結果に引っかからなかった場合は 処理3 シート2の各セルをコピーしてシート1の最下部の各セルに付け足していく end if ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- シート1のA列にあって、シート2のA列に無い。 と言うパターンは無いんですか? 後シート2のA列には、重複する値は無いんですか? （sy） 2018/04/03(火) 17:32 ---- もう少し質問です。 IF文よりもSELECT CASEの方が適してますし、もっと言えば、 数式やフィルターオプションを使えば、ループやIF文での判定なども必要ありませんが、 そう言う事では無く、IF文の勉強がしたいと言う事でしょうか? 取り合えずIF文でご提示の条件以外はあり得ないと言う前提でヒントを言えば、 判定部分はすべてCOUNTIFで個数で判断すれば良いです。 シート2のA列の値を検索条件にして、シート1のA列に何個あるか(1・2個以上・0)を条件式にします。 処理1の条件式は以下のような記述になります。 worksheetfunction.countif(sheets("シート1").range("A:A"),sheets("シート2").range("A"&i))=1 処理2の条件式は=1の部分を>=2と2以上を指定 処理部分はMATCH関数などで行を特定して下さい。 （sy） 2018/04/03(火) 20:33 ---- syさん コメントありがとうございます。 まだまだ勉強中なので、 if文以外にもこの動作に適したものがあれば教わりたいです。 シート1にあって2にないものはたくさんあります。 シート2以外にも同じようなデータでシート3や4があり、 シート1はそれらの寄せ集めのデータベースのようなものになります。 シート2を使ってシート1を更新してあげられるようなイメージです。 更新の数が多いので VBAで操作できたらと思ってます!! （きれいこさん） 2018/04/03(火) 23:09 ---- >シート2以外にも同じようなデータでシート3や4があり、 >シート1はそれらの寄せ集めのデータベースのようなものになります。 あっ、これは厄介な問題かも? 例えば、シート2やシート3でA列に共通の値があれば、シート1のデータはどのシートの値を反映させるんですか? それともシート2以降のシート同士では同じ値は無いですか? 上記の事も含めて他にも以下の質問にお答えください。 完成イメージにずれが生じて的確な回答ができないので、全部の質問にお答えください。 1、初めにも聞いてますが、シート2やシート3と言った引用元のシートでA列に重複はありますか? 2、重複があれば、AEやAF列の値も同じ値ですか? 3、もしも違う場合はどの値を転記するんですか? 4、シート1のBPかBS列に初めから値が入っている行の場合はどうするんですか? 5、入っている場合、片方だけ値が入ってると言うパターンはありますか? 6、片方だけの場合は、空欄だけ転記するような事はありますか? 7、シート構成は、シート1が纏めシートで、残りの全てのシートのデータを転記で良いんですか? データ用のシート以外に今回のマクロに関係ないシートはありますか? 8、全てのシートとも、AE、AF列のデータをBP、BS列に転記で良いんですか? 後、仕事が忙しいので、回答はスローペースになります。 申し訳ありません。 ですが質問に答えてくれていたら、他の回答者さんも回答しやすいので、質問の回答は下さい。 （sy） 2018/04/03(火) 23:53 ---- syさん お返事ありがとうございます。 ◎追加情報 ★上書きしたい個所について シート2のAE列AF列を シート1のBP列BS列に上書きしたいと記述しましたが [シート2のX列AE列AF列AJ列]を [シート1のAI列BP列BS列BW列]に上書きしたい に変更させてください シート2のX列AJ列:シート1のAI列BW列は 契約情報の進行度が区分されています。 シート2はあらかじめフィルターでX列の区分で 更新したいものだけ表示されるようにしています。 ◎シートの関係性について このブック自体は各契約状況をまとめた簡易データベースです。 Accessなどは使わず、エクセル内で処理を完結したいです。 シート1はシート2～4を蓄積したデータベースで 下記のような関係性です。 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ シート1 2～4がまとめられ随時更新されていく簡易データベース ↑ シート4が初めのデータになっているためそのままコピペ シート4(前々前月分) ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ シート1(シート4コピペ) ↑ 3と1のA列で同じキーワードがない場合は 古 新規データとしてシート1最下部に付け足し。 3と1のA列でA列で同じキーワードがあったものは 新 シート3でデータが更新されているため ↓ シート3のX列AE列AF列AJ列をシート1のAI列BP列BS列BW列に貼り付け。(この4つのセルしか基本的に変わりません) シート3(前々月分) ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ シート1(シート4コピペ+シート3) ↑ 2と1のA列で同じキーワードがない場合は 古 新規データとしてシート1最下部に付け足し。 2と1のA列でA列で同じキーワードがあったものは 新 シート2でデータが更新されているため ↓ シート2のX列AE列AF列AJ列をシート1のAI列BP列BS列BW列に貼り付け。(この4つのセルしか基本的に変わりません) シート2(前月更新分) ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ 1、初めにも聞いてますが、シート2やシート3と言った引用元のシートでA列に重複はありますか? A. A列内で重複はあります。A列のキーワードが同じであればそのあとのセルの中身も同じです。重複データはあらかじめ削除するほうが確実ですよね。 2、重複があれば、AEやAF列の値も同じ値ですか? A.同じです。 3、もしも違う場合はどの値を転記するんですか? A.違った場合でもシート1よりシート2のほうが最新の情報になるのでシート2の情報で上書きします。 4、シート1のBPかBS列に初めから値が入っている行の場合はどうするんですか? A.シート2のほうが情報が新しいため、上書きをします。 5、入っている場合、片方だけ値が入ってると言うパターンはありますか? A.あります。あった場合もシート2のほうが新しいということになるので上書きします。 6、片方だけの場合は、空欄だけ転記するような事はありますか? A.おそらくそれはマクロ化するにあたり、難しいと考えたので[シート2のX列AE列AF列AJ列]でセットにして[シート1のAI列BP列BS列BW列]に上書きしたいです。 7、シート構成は、シート1が纏めシートで、残りの全てのシートのデータを転記で良いんですか? データ用のシート以外に今回のマクロに関係ないシートはありますか? A.認識でお間違いないです。 データ用のシート以外に関係ないシートもあります。 グラフなどを入れているシートです。 8、全てのシートとも、AE、AF列のデータをBP、BS列に転記で良いんですか? A.[シート2のX列AE列AF列AJ列]を[シート1のAI列BP列BS列BW列]に転記、上書きで問題ないです。 ご回答、ご返信はスローペースで問題ございません。 ぜひ勉強させてください。 （きれいこさん） 2018/04/04(水) 11:33 ---- 下記リンクのサイトをみて 私なりに式を組み立ててみました。 考え方的にあっているか、 教えて頂きたいです。 https://www.sejuku.net/blog/30642 http://www.atmarkit.co.jp/ait/articles/1403/04/news082_4.html 冒頭で記載していた2番めの処理（検索結果が複数だった場合～）は とりあえず考えないことにしました。 ActiveSheet.Range("$A$1:AZ" & Cells(3).CurrentRegion.Rows.Count).AutoFilter Field:=24, Criteria1:="区分" 'オートフィルタ Range("A1").Select Do Until Cells(1, 0) = "" 'どこから処理を開始したいか 縦に1つ下がった位置からから Select Case ｛元になる式｝ Case ｛比較する式1｝シート2のA列とシート1のA列を '～ここに｛元になる式｝と｛比較する式1｝が一致する場合の処理を書く～ '→[シート2のX列AE列AF列AJ列]を[シート1のAI列BP列BS列BW列]に貼り付ける Case Else '～ここに｛元になる式｝がどの式とも一致しなかった場合の処理を書く～→シート1の最下部に付け足しをする '←この部分の処理はシート4をシート1にまるまる貼り付けたときのマクロを引用してみます '→シート1の最下部に付け足しをする '←この部分の処理はシート4をシート1にまるまる貼り付けたときのマクロを引用してみます End Select Loop （きれいこさん） 2018/04/04(水) 13:52 ---- 難しく考えなくても、エクセルには重複の削除という機能があります。 つまり、1枚のシートにデータを集積し、 重複の削除と命令してやれば事足ります。 マクロが無くても、 1）コピーして、 2）貼付をして、 3）重複の削除をする です。手動でも十分かと。。。 多少失敗してもいつでも元に戻せるわけですし。。。 コツは、重複の削除をして残るのは上から見て一番最初に出てくるデータなので、 表の上に残したいものを挿入します。 順番も重要なら後で並び替えれるように番号があると（一時的に付けるのもあり） より便利でしょう。 Sub test() Dim rngFrom As Range Dim rngTo As Range Set rngTo = Worksheets(1).Range("A2") With Worksheets(2).UsedRange Set rngFrom = Intersect(.Cells, .Offset(1)) End With rngFrom.Copy rngTo.Insert Shift:=xlDown rngTo.Worksheet.UsedRange.RemoveDuplicates Header:=xlYes End Sub （まっつわん） 2018/04/04(水) 14:32 ---- まっつわんさん お返事ありがとうございます。 重複分削除に関して、 上の人と交渉中です。 やっぱりデータベースになるので A列のキーワードが唯一じゃないと処理が難しいですよね。 一旦重複がないものとして考えてみます。 （きれいこさん） 2018/04/04(水) 15:09 ---- もう少し簡単に処理の方法を考えてみました。 ネットからコピペ引用で考えてるので 荒業になっていると思うので どう再修正したらいいか教えて下さい ◎やりたい処理 シート2の1行目で"区分"でオートフィルター 2行目から最下部まで処理を繰り返す シート1のA列をシート2のA1行目で値で検索 →見つからないとき シート2の行に色を付ける →それ以外=見つかったとき シート2のX.AE.AF.AJをシート1のAI.BP.BS.BWに貼り付ける 色付きのものだけをフィルターで抽出 新規を引用し、貼り付け。 ◎考えてみたもの Worksheets("シート2").Range("$A$1:AZ" & Cells(3).CurrentRegion.Rows.Count).AutoFilter Field:=24, Criteria1:="区分" 'シート2の1行目で"区分"でオートフィルター Range("A1").Select Dim i For i = 2 To Cells(Rows.Count, 1).End(xup).Row '2行目から最下部まで処理を繰り返す Dim rng As Range Set rng = Worksheets("シート1").Range("A2:A").Find(What:=ActiveCell.Value) If FoundCell Is Nothing Then '見つからないとき With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid 'もし検索結果に引っかからなかった場合は色をつける（色を全部つけ終わった後フィルターをかけてまとめて貼り付ける） End With else 'もし見つかったら '[シート2のX列AE列AF列AJ列]を[シート1のAI列BP列BS列BW列]に貼り付ける '↑この処理が思いつかないです。。。 end if （きれいこさん） 2018/04/04(水) 15:10 ---- ＞A列のキーワードが唯一じゃないと処理が難しいですよね。 ん?重複の削除の機能では、 全部の列を見ることも可能ですし、一部の列だけで判断もできます。 なのでユニークなキーをわざわざ用意する必要はありません。 ＞'もし見つかったら ＞'[シート2のX列AE列AF列AJ列]を[シート1のAI列BP列BS列BW列]に貼り付ける ＞'↑この処理が思いつかないです。。。 んと、検索機能で検索するのではなく、 ワークシート上で使うMatch関数がVBAでも利用可能なので、 それを使って検索してみては? 見つかれば行番号が返ってきますのでそれを利用できますよね? 見つからなければエラー値を返しますので、 それで処理の分岐をするとよいでしょう。 http://www.diamondblog.jp/official/omura/2016/03/24/match関数で完全に一致するデータを検索するexcel-vba/ （まっつわん） 2018/04/04(水) 16:28 ---- 何で重複の削除が出てきてるんだろう? データベースの更新がしたいんですよね? しかも各シートA列には重複があって、他の列のデータと合わせて主キーにすると言う事ですよね。 だとしたら重複の削除なんか使って大丈夫かな? 意図しないデータが残ったり、消してまずいデータが消える可能性を0にする為に更に色々条件を検証しないといけないし、 初めに提示のあった並び順に調整するにも一手間かかるし、 データベースのデータは必要部分だけを編集すると言う考え方の方が、トラブルが少ないですよ。 今回の要件では重複の削除は、私的にはお勧めできない方法ですね。 ただ本当にデータベースなの?と思うコメントがありますね。 >シート1 2～4がまとめられ随時更新されていく簡易データベース > ↑ シート4が初めのデータになっているためそのままコピペ >シート4(前々前月分) なぜシート1のデータを全て消して、丸ごとシート4のデータに書き換えるんですか? データベースとは、データを蓄積して、必要な情報を抜き出して活用する為の物です。 毎回全てのデータを消してしまうのでしたら、それは単なる纏めシートです。 最終出力帳票もしくはその1つ前段階になるので、大元であるデータベースとは真逆の物になります。 纏めシートなら、重複の削除を使って手順を簡略化と言うのは納得できます。 それでも必要情報だけを正確に残す為には、今の条件だけでは足りませんが。 どっちにしても、ループを条件判断で1件ずつ処理するか、数式とフィルターで一括処理する方が、確実性は高そうに思います。 どうせマクロがしてくれるんですから、私ならより確実性の高い方法を採用しますね。 毎回シート1の全てのデータをリセット(全消去)して、シート2～4のデータを纏めると言う事がしたいのでしょうか? （sy） 2018/04/04(水) 20:52 ---- 今現在分かっている条件は、 必要なシートは4つ、他にもシートはある。 シート1:まとめシート(ただし実行時に前回データは全消去) シート2:前月データ シート3:前々月データ シート4:前々前月データ 変更したい列は、 元シート(2～4):X,AE,AF,AJ列 シート1:AI,BP,BS,BW列 A列が同じ行のデータを、シート2、3、4のデータに上書きしたい。 データはシート2＞3＞4＞1の優先順位で残す。 古いデータは上書き。 A列でシート1に存在しないデータは行ごと、シート1の最終レコードに追加 シート1～4全てにA列のキーの重複がある。 重複はあっても転記する列のデータは、各シート内では全て同じ。 要は一番上のデータだけを転記すれば良い。 更新する場合は1行の該当列全てを一括更新。 これで良いですか? 私の「厄介な問題かも」発言は無視して下さい。 混乱させて申し訳ありません。 重複データの該当列の値がバラバラだと転記条件が後だしで少しずつ出てきて めんどくさい事になりそうだと想像してしまいました。 値が全て同じなら、重複があっても一切問題ありません。 後、新たな条件がありますね? シート2(3、4も?)の表示されているデータだけを転記対象にするんですか? 非表示データは更新の対象からは外れると言う事ですか? （sy） 2018/04/04(水) 21:21 ---- >For i = 2 To Cells(Rows.Count, 1).End(xup).Row '2行目から最下部まで処理を繰り返す これフィルタリングしてるんですよね? 非表示の行も検索対象になってしまいますよ。 > else 'もし見つかったら > '[シート2のX列AE列AF列AJ列]を[シート1のAI列BP列BS列BW列]に貼り付ける > '↑この処理が思いつかないです。。。 この処理の説明も含めて表示されているデータだけを検索するなら以下のようなコードになります。 シート3、2の順にmatch関数で見つかったシート1の行のセルに転記しています。 シート読込の順番が3、2なのでシート2のデータで上書きします。 Sub test1() Dim sh(1) As Worksheet Dim r As Range Dim i As Long Dim v As Variant Set sh(0) = Sheets("シート3") Set sh(1) = Sheets("シート2") For i = 0 To 1 For Each r In sh(i).UsedRange.Columns(1).Cells.Offset(1).SpecialCells(xlCellTypeVisible) v = Application.Match(r.Value, Columns(1), 0) If IsError(v) Then r.Resize(, 52).Copy Range("A" & Rows.Count).End(xlUp).Offset(1) Else Range("AI" & v).Value = r(1, "X").Value Range("BP" & v).Value = r(1, "AE").Value Range("BS" & v).Value = r(1, "AF").Value Range("BW" & v).Value = r(1, "AJ").Value End If Next r Next i End Sub 但しこのコードは、A列に重複がある場合は、処理ができません。 なのでシート1に重複があるような場合は、findメソッドを使うと良いです。 以下のコードは、findメソッドで重複がある場合は、ループで全ての行に転記しています。 これなら処理1と処理2を同時に行うので、条件分岐で分ける必要もないですね。 処理3の見つからなかった時だけ条件分岐させれば良いです。 色々な処理方法があるけど、おそらく一番遅い(処理時間が長い)方法ですけど、記述が簡単なのでお勧めです。 Sub test2() Dim sh(1) As Worksheet Dim fRng As Range Dim r As Range Dim s As String Dim i As Long Set sh(0) = Sheets("シート3") Set sh(1) = Sheets("シート2") For i = 0 To 1 For Each r In sh(i).UsedRange.Columns(1).Cells.Offset(1).SpecialCells(xlCellTypeVisible) Set fRng = Range("A:A").Find(r.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If fRng Is Nothing Then r.Resize(, 52).Copy Range("A" & Rows.Count).End(xlUp).Offset(1) Else s = fRng.Address Do fRng(1, "AI").Value = r(1, "X").Value fRng(1, "BP").Value = r(1, "AE").Value fRng(1, "BS").Value = r(1, "AF").Value fRng(1, "BW").Value = r(1, "AJ").Value Set fRng = Range("A:A").FindNext(fRng) Loop Until fRng.Address = s End If Next r Next i End Sub 提示のコードでわからない部分などは、質問してください。 取り合えず明日も仕事なので、他の方法(数式処理)は後日と言う事で、もう寝ます。 （sy） 2018/04/04(水) 23:27 ---- 忘れてた! 提示のコードは、シート1のシートモジュールに貼り付けてください。 標準モジュールだと問題が起きる事があります。 （sy） 2018/04/04(水) 23:34 ---- syさん 夜遅くにご苦労さまです。。 お仕事でお忙しい中、お時間割いて頂きありがとうございます。 もともとシート1は項目しか入っていないシートです. 1行目、2行目を使って項目が入ってます。 A3からシート4の中身だけをコピペし、 その後、シート3の情報、シート2の情報と上書きしていきます。 重複してしまっているものに関しては CSVを吐き出す自社のシステムがおばかさんなせいです。。。 上長と重複に関しては全く同じデータでも 契約数も集計しているので削除は難しいという結論に至りました。 シート2の表示されているものだけを転記して行きたいです。 Forだと非表示のも更新されてしまうんですね(難しい。。。) 必要なシートは4つ、他にもシートはある。 シート1:まとめシート(ただし実行時に前回データは全消去)←削除はしないです。 シート2:前月データ シート3:前々月データ シート4:前々前月データ 変更したい列は、 元シート(2～4):X,AE,AF,AJ列 シート1:AI,BP,BS,BW列 コードの提示、ありがとうございます。 ちょっと時間かけて自分で中身を見てみます! （きれいこさん） 2018/04/05(木) 09:56 ---- Syさん お疲れ様です。 下記コードに関して、ちょっと質問なのですが 実際に操作したいブックと 標準モジュールにマクロが書き込んであるブック←今回のコードもここに 同時に開いておき マクロを使用する際は開いているすべてのブック～で 使用しようと考えていたのですが マクロが書き込んであるブックのシートモジュールにこのコードを貼り付けた場合、 実際に操作したいブックでも問題なく動作しますでしょうか。 また、シート2のように毎月最新データを反映する必要があるのですが シートが増えた場合はどのように書き換えればよいでしょうか。 (最大12シート) 作業として1回あたり1シート分の作業で動かしたいです。 お忙しいところ申し訳ないですが お手すきになられましたらご回答いただけると幸いです。 Sub test2() Dim sh(1) As Worksheet Dim fRng As Range Dim r As Range Dim s As String Dim i As Long Set sh(0) = Sheets("シート3") Set sh(1) = Sheets("シート2") For i = 0 To 1 For Each r In sh(i).UsedRange.Columns(1).Cells.Offset(1).SpecialCells(xlCellTypeVisible) Set fRng = Range("A:A").Find(r.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If fRng Is Nothing Then r.Resize(, 52).Copy Range("A" & Rows.Count).End(xlUp).Offset(1) Else s = fRng.Address Do fRng(1, "AI").Value = r(1, "X").Value fRng(1, "BP").Value = r(1, "AE").Value fRng(1, "BS").Value = r(1, "AF").Value fRng(1, "BW").Value = r(1, "AJ").Value Set fRng = Range("A:A").FindNext(fRng) Loop Until fRng.Address = s End If Next r Next i End Sub （きれいこさん） 2018/04/05(木) 10:32 ---- ＞マクロが書き込んであるブックのシートモジュールにこのコードを貼り付けた場合、 ＞実際に操作したいブックでも問題なく動作しますでしょうか。 掲示板に書き込んで答えを待っているより、とりあえず試してしまった方がはやく結果がわかりますよ まぁ答えを言ってしまうと、状況によりますね。 提示のコードは、どのブック、どのシートか記述を省略している箇所がありますので、記述を省略した部分は、Activebook、ActiveSheetと解釈されます。 そのように、解釈された上で、辻褄があうなら、無事にコードは実行されるでしょうし、辻褄が合わない（たとえば、Activebookに「シート3」というシートが無い。ということであれば、実行時エラーが発生するとおもわれます。 （もこな2） 2018/04/05(木) 12:50 ---- >マクロが書き込んであるブックのシートモジュールにこのコードを貼り付けた場合、 >実際に操作したいブックでも問題なく動作しますでしょうか。 動作しません。 操作したいブックは別にあると言う事ですか? もこな2さんが述べられているように、まず試すのは大事と思います。 回答の方はたぶん標準モジュールに記述されてると勘違いされてるんだと思います。 シートモジュールに記載したマクロの場合、ブック名・シート名両方省略すると、 ActiveWorkbook、ActiveSheetがどうであれ、 マクロが記述されているシートに対して実行されます。 ブック名を省略すると、ActiveWorkbookの記述されたシート名のシートに対して実行されます。 標準モジュールで同じように書くと、 省略した、ブック名、シート名は、それぞれActiveWorkbook、ActiveSheetと判断されます。 ついでにThisWorkbookモジュールに記述した場合は、 ブック名・シート名両方省略すると、ActiveWorkbookのActiveSheetに実行され、 ブック名を省略すると、マクロが記述されているブックの記述されたシート名のシートに対して実行されます。 （sy） 2018/04/05(木) 21:43 ---- ＞syさんへ 質問者さんは ＞標準モジュールにマクロが書き込んであるブック←今回のコードもここに って言ってるので、標準モジュールのときの説明だけでいいかな～なんておもったけど、ちょっと不親切でしたね。フォローありがとうございます。m(_ _)m （もこな2） 2018/04/05(木) 22:15 ---- どうも後出しの情報が多いので、今一何がしたいのか分からなくなってきた? もう一度重複する部分もありますが、情報を整理した方が良いと思うので、いくつか質問させて下さい。 1、マクロブックはマクロを記述しているだけで、マクロブックのシートを操作する事は無いと言う事ですか? 2、元のデータは業務システムなどからCSVを出力して、纏め用ブックのデータシートなどにコピペなどで貼付てるんですか? 3、最大12シートと言うのは、過去1年分のデータシートと纏めシートがあると言う事ですか? (その他のグラフシートなどは、この際無視します) 4、>マクロを使用する際は開いているすべてのブック～で この文面は理解できません? なぜ出力されたブックが複数あるんでしょうか? 例えば今日出力させれば、今日までの今月データと、12か月分の過去データ(12シート)、 纏めシートのあるブックは、1つだけでは無いんですか? 他のブックにはどんなデータがあるんですか? 5、>もともとシート1は項目しか入っていないシートです マクロで纏めたデータの入ったシートは、次にマクロを実行する時にはどうなってるんですか? それとも纏めシートが完成すればOKで。 そのブックに対してマクロを実行するのは1回限りと言う事ですか? 毎回新規ブックに別のデータを業務システムなどから月単位で出力させて、毎回纏めると言う事ですか? 6、>作業として1回あたり1シート分の作業で動かしたいです。 古い月のシートから順に、纏め用のシートに転記していくんじゃないんですか? （sy） 2018/04/05(木) 22:45 ---- もこな2さん ＞標準モジュールにマクロが書き込んであるブック←今回のコードもここに 私も一瞬標準モジュールに記述してるのかなと思ったんですけど、その後に「シートモジュールに記載したら」 って言われてるので、おそらく今までのコードは標準モジュールに記述してたんだって事だと思います。 私もついシートモジュールに記述して、シート装飾などを手抜きしたがる悪い癖が出てしまって、 質問者さんを混乱させてしまったかも? きれいこさん、混乱させてすいません。 このスレでは今後、全て標準モジュールに記述する用のコードを書くようにします。 （sy） 2018/04/05(木) 22:54 ---- あっほんとだ・・・「シートモジュールにこのコードを貼り付けた場合」って言ってますね。 失礼しました。 であれば、こうですかね。（間違っていたら適宜ツッコミをお願いします＞All） 標準モジュールで ・シートを省略→ActiveSheetと解釈 ・ブックを省略→ActiveBookと解釈 シートモジュールで ・シートを省略→そのシートと解釈 ・ブックを省略→そのシートが属するブックと解釈 ThisWorkbookモジュールで ・シートを省略→そのブックのActiveSheetと解釈? ・ブックを省略→そのブックと解釈 ちなみに、特に理由もなく、標準モジュール以外に記述をしているのであれば、一度、この辺にも目を通してみるとよいかもしれません。 http://officetanaka.net/excel/vba/beginner/10.htm https://excel-ubara.com/excelvba4/EXCEL251.html （もこな2） 2018/04/06(金) 00:26 ---- もこな2さん ちょっと違います。 そのモジュールがどのオブジェクトに属しているかで対象が変わります。 属しているオブジェクトの装飾を省略した場合だけ、その装飾は自身と判断されます。 それ以外の時はActiveなオブジェクトになります。 シートモジュールはWorksheetオブジェクトに属しているので、シート名を省略した場合だけ自シートと判断されます。 ブック名を記載して、シート名だけ省略と言う記述はできないので、この場合ブック・シート両方省略と言うパターンになります。 ブック名だけ省略した場合は、属してないオブジェクトなので、ActiveWorkbookが対象になります。 ThisWorkbookモジュールはWorkbookオブジェクトに属しているので、ブック名を省略した時は自ブックと判断されます。 シート名まで省略すると、Worksheetオブジェクトの範疇になり属してないので、ActiveWorkbookのActiveSheetが対象になります。 標準モジュールはWorkbookオブジェクトに属してますがPublicな記述を出来るようにしたオブジェクトなので、 常にActiveWorkbookやActiveSheetだけが対象になります。 今回シートモジュールに記載されてるのは、私が提示したコードがシートモジュール用だったからです。 別ブックを操作する事は想定してませんでした。 （sy） 2018/04/06(金) 06:35 ---- まとめつつ、お答えします。 考え方的にシートの番号が逆のほうがわかりやすいかもしれない。。。 ✕必要なシートは4つ、他にもシートはある。 シート1:まとめシート(全て前回データの下に付け足しor更新) シート2:前月データ シート3:前々月データ シート4:前々前月データ ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ★必要なシートは4つ、他にもシートはある。 シート1:まとめシート(全て前回データの下に付け足しor更新) シート2:前々前月データ ↓一ヶ月後 シート3:前々月データ ↓一ヶ月後 シート4:前月データ(最新!) シートは今後も増えていき、最大でシート13になる ★変更したい列は、 元シート(2～4):X,AE,AF,AJ列 を シート1:AI,BP,BS,BW列 に上書き。 A列が同じ行のデータを、シート1に上書きしたい。 古いデータ（シート1）に上書き。 A列でシート1に存在しないデータは行ごと、シート1の最終レコードに追加 シート1～4全てにA列のキーの重複がある。 重複はあっても転記する列のデータは、各シート内では全て同じ。 要は一番上のデータだけを転記すれば良い。 更新する場合は1行の該当列全てを一括更新。 1、マクロブックはマクロを記述しているだけで、マクロブックのシートを操作する事は無いと言う事ですか? A.そうです。シートや各項目などは実際のデータ入のブックと同じように設定してあるので マクロブックで正常に動作ができれば実際のデータ入のブックでも同じ様に動作ができます。 2、元のデータは業務システムなどからCSVを出力して、纏め用ブックのデータシートなどにコピペなどで貼付てるんですか? A. 1.業務システムが最新月のCSVを吐き出す(データの原本) 2.実際のデータ入のブックにコピペ(ブック内で見れるようにするため:いちいち別ブックを開かない) 3.実際のデータ入のブックでまとめシートに貼り付けやすいように加←シート2.3.4 4.実際のデータ入のブックとマクロブックを同時に開く 5.実際のデータ入のブックを開き、マクロ→開発タブを押すと「保存先:開いているすべてのブック状態」だと マクロブックのマクロを実際のデータ入のブックで使える 3、最大12シートと言うのは、過去1年分のデータシートと纏めシートがあると言う事ですか? A.12ヶ月分+まとめシートで操作したシートは13シート。 ですが毎月最新月のみの更新になるので 最新月1ヶ月分:まとめシートで処理したいです。 一つ数え間違いました。 (その他のグラフシートなどは、この際無視します) 4、>マクロを使用する際は開いているすべてのブック～で この文面は理解できません? なぜ出力されたブックが複数あるんでしょうか? 例えば今日出力させれば、今日までの今月データと、12か月分の過去データ(12シート)、 纏めシートのあるブックは、1つだけでは無いんですか? 他のブックにはどんなデータがあるんですか? A.まずマクロのブックと実際のデータ入りのブックを分ける理由として 実際のデータ入りのブックのサイズが大きすぎるため、その中にマクロを書くと フリーズしてしまったことが多々あり、分けることにしました 動作方法などに関しては2番の質問で回答致しました。 5、>もともとシート1は項目しか入っていないシートです マクロで纏めたデータの入ったシートは、次にマクロを実行する時にはどうなってるんですか? それとも纏めシートが完成すればOKで。 そのブックに対してマクロを実行するのは1回限りと言う事ですか? 毎回新規ブックに別のデータを業務システムなどから月単位で出力させて、毎回纏めると言う事ですか? A.一連の流れについて、 年始-4月 1.実際のデータ入のブックとマクロブックと業務システムが吐き出した(データの原本)を用意する 2.(データの原本)実際のデータ入のブックの「シート2」コピペ、まとめシートに貼り付けやすいように加工 3.まとめシートにコピペ(年度始まりはシート1-まとめシートが項目のみになっている) (ここでは情報を更新する必要がないため質問した処理は発生しない。) -----5月 4.実際のデータ入のブックとマクロブックと業務システムが吐き出した(最新月のデータの原本)を用意する 5.(データの原本)実際のデータ入のブックの「シート3」コピペ、まとめシートに貼り付けやすいように加工 6.新しく入ってきた契約はシート1-まとめシートの最下部から貼り付けて付け足す 7.情報の更新（質問させて頂いてるマクロ処理）をする ---次月繰り返し 6、>作業として1回あたり1シート分の作業で動かしたいです。 古い月のシートから順に、纏め用のシートに転記していくんじゃないんですか? A.毎月、最新月分が出てきてまとめていくので まとめシート:最新月のシートでまとめたいです。 （きれいこさん） 2018/04/06(金) 09:47 ---- なるほど!完全に理解しきれてるかは分からないけど、やっと全容が見えてきました。 1、業務システムから先月データをCSVとして出力。 2、そのCSVをDBブックの最新データとしてシート追加して、内容をコピペ。 3、年間の纏め用DBの、A列(顧客名かな?)?で検索して同じレコードのAI,BP,BS,BW列に、 最新データのX,AE,AF,AJ列の内容に更新。 4、新規レコードは最下部に追加。(この時、AI,BP,BS,BW列はどうなるんですか?) 上記を毎月繰り返し、1年分のデータを保存し、 年度が替わると、真っ新な纏めDBに1から同じ事をする。 と言う流れで良いですか? 年度のスタートの月のデータシートだけは、丸ごとコピペすると言う事ですか? その時と、上記でも触れた新規レコードに追加する時は、AI,BP,BS,BW列はどうなれば良いんですか? 初めの月の丸ごとコピペのコードは作成済なんですか? まぁ無くても、BD側に無いデータは、新規レコードとして追加されるから、別途用意しなくても問題ないですけどね。 先々月までのデータは必ず先月までに処理しているので、今月処理するのは先月分だけで良いと言う事ですね? CSVからデータシートに貼り付けや加工もマクロで行えば良いように思うけど、何か不都合でもあるんですか? マクロを実行する時は、ActiveWorkbookと言う不確実な指定は絶対に避けた方が良いです。 なのでDBブックのブック名を「〇〇〇2018年度.xlsx」などと言う、決まったブック名に年をつけて識別する事は出来ないですか? こうすれば確実に対象のDBブックに実行されるので、実は違うブックに実行していてデータが正しく更新されていなかった と言う事故を防ぐ事が出来るので、強くお勧めします。 業務としてのDBシステムならそうするべきです。 上司次第かも知れませんが、ファイル名を上記命名ルールにする事は可能でしょうか? 後データシートのシート名ですけど、年度始まりの月は決まってるんですよね? シート名は4月始まりとかなら、「4月」「5月」のように何月と言うシート名の方が、分かりやすいと思うんですけど。 始まりの月は何月からでも、マクロに最新月のシートを認識させる事は出来ます。 此方は単にその方が分かりやすいと思っただけなので、今のままでも実行に支障はないです。 （sy） 2018/04/07(土) 13:18 ---- syさん お返事ありがとうございます。 ＞4、新規レコードは最下部に追加。(この時、AI,BP,BS,BW列はどうなるんですか?) →AI,BP,BS,BW列にはその段階でのデータが既に入っています。 ＞上記を毎月繰り返し、1年分のデータを保存し、 年度が替わると、真っ新な纏めDBに1から同じ事をする。 と言う流れで良いですか? →はい!問題ないです ＞年度のスタートの月のデータシートだけは、丸ごとコピペすると言う事ですか? →まるごとコピペしてます ＞その時と、上記でも触れた新規レコードに追加する時は、AI,BP,BS,BW列はどうなれば良いんですか? →年度の始まりの時は他のものと同じ様にまるごとコピペをしてほしいです! ＞先々月までのデータは必ず先月までに処理しているので、今月処理するのは先月分だけで良いと言う事ですね? →先月分のみで大丈夫です(*^^*) ＞ CSVからデータシートに貼り付けや加工もマクロで行えば良いように思うけど、何か不都合でもあるんですか? →シートの貼り付けや加工に関しては私の方でマクロを組むことが出来ました! (ただセルの場所名でしてしまって項目名で指定できるようにFindメゾットに直してます。。。 もし可能であれば今回のものもFindメゾットで項目名指定ができるといいなと思います。その場合項目名はまたお伝えします! 難しいようであれば、自身でいろいろ考えてみます。。。) ＞マクロを実行する時は、ActiveWorkbookと言う不確実な指定は絶対に避けた方が良いです。 なのでDBブックのブック名を「〇〇〇2018年度.xlsx」などと言う、決まったブック名に年をつけて識別する事は出来ないですか? こうすれば確実に対象のDBブックに実行されるので、実は違うブックに実行していてデータが正しく更新されていなかった と言う事故を防ぐ事が出来るので、強くお勧めします。 →確かにそうですね! Sheets("シート1").Selectのような形で記述することを心がけてみます! ＞上司次第かも知れませんが、ファイル名を上記命名ルールにする事は可能でしょうか? 後データシートのシート名ですけど、年度始まりの月は決まってるんですよね? シート名は4月始まりとかなら、「4月」「5月」のように何月と言うシート名の方が、分かりやすいと思うんですけど。 始まりの月は何月からでも、マクロに最新月のシートを認識させる事は出来ます。 此方は単にその方が分かりやすいと思っただけなので、今のままでも実行に支障はないです。 →命名にルールはないため、変えても問題ないと思います! 上司に相談したところ、変えたほうがわかりやすくてよいとのことで 問題なさそうでした(・∀・) お返事が遅くなってしまい申し訳ないです。 お仕事がお手すきになられましたら またお返事頂けると幸いです。 （きれいこさん） 2018/04/10(火) 10:19 ---- 昨日は仕事が遅かったので、まだ返信全部読めて無いけど、 幾つか教えて下さい。 処理対象のDBブックは何処に保存されてるんでしょうか? マクロブックと同じフォルダーなら一番簡単だけど、 デスクトップにフォルダーを作ってとかでも比較的簡単です。 それ以外は、フルパスを登録しないと行けませんね。 年度始まりは何月ですか? csvファイルは決まったフォルダーにダウンロードされるんですか? ダウンロードされたcsvファイルは、決まったファイル名になってますか? 今日はノー残業デーなので、コード書いてみます。 （sy） 2018/04/11(水) 07:41 ---- お返事の速度に関して、 syさんの手が空いたときで問題ないので お気になさらないで下さい! ノー残業デー、素敵ですね(^O^) ＞＞＞処理対象のDBブックは何処に保存されてるんでしょうか? マクロブックと同じフォルダーなら一番簡単だけど、 デスクトップにフォルダーを作ってとかでも比較的簡単です。 それ以外は、フルパスを登録しないと行けませんね。 →いつも操作する際はマクロブックも実データ入りのブックも デスクトップに落として操作してます! コード内にファイル場所を記載するということでしょうか? やはりマクロブックと実データブックを両方開いて マクロを参照する方法はあまりよくないですかね(';') ＞＞＞年度始まりは何月ですか? →4月です ＞＞＞csvファイルは決まったフォルダーにダウンロードされるんですか? →決まったフォルダーにダウンロードされていて それを実データ入りのブックの4月、5月、6月...にそれぞれ貼り付け、 マクロブックと実データブックを両方開いて マクロを参照し、加工しています! ＞＞＞ダウンロードされたcsvファイルは、決まったファイル名になってますか? →その月その月で若干名前が変わります。ファイル名_20XX年○月みたいな形式です。 実データ内に先にコピーしているので開くことはあまりないです。 以上、宜しくお願い申し上げます! 次このマクロを使うのが一か月後になるので 時間があるときにで問題ないです(p_-) ノー残業デー、ゆっくり休めるといいですね! （きれいこさん） 2018/04/11(水) 09:29 ---- ノー残業デーなんて無かったorz >次このマクロを使うのが一か月後になるので 良かった。 時間出来たらしっかり読ませて頂きます。 （sy） 2018/04/11(水) 23:46 ---- syさん 今の世の中にノー残業デーはなさそうです() お忙しい中、ありがとうございます。 今後共宜しくお願い致します!! （手はおひざ） 2018/04/12(木) 09:14 ---- [[20180409113657]] 『Find エラー 「オブジェクトが必要です」 解決方法』（手はおひざ） [[20180409154204]] 『find オートフィルと動きを組み合わせたい』（手はおひざ） 同じ方ですか? 私はHNを変える事自体は気にしませんが、並行して関連しそうな質問をする時は、 出来るだけ別のスレで「こう言う質問をしてるよ」と言う事を教えて下さい。 理由は此方で進行している内容に関連ある事で、別のスレで全然違うアプローチを教えてもらったりした時に、 (回答者のスキルの差や記述スタイルや考え方の違いなどで、相容れない方法になる事があります) このスレでの私の回答と相性が悪ければ、エラーになったり意図しない動きをする可能性が高いです。 そんな時でも、私が別スレでの情報を知っていれば、原因究明がしやすかったり、 回答そのものを調整する事も可能だからです。 特に今回A列以外にキーそのものが移動する可能性があるような事を別スレでは質問されていますが、 私が知らないままだと、A列固定の回答になり原因が分からず、お互い無駄な時間を費やしかねないです。 まぁそう言う理由ですので、何か事情があれば仕方ないですが、私も出来る限りの力になりたいと思ってますので、 他にも別スレがあれば全部教えて下さい。 肝心の重要事項の確認ですけど、キー列がA列から移動する事もあるんですか? （sy） 2018/04/12(木) 22:14 ---- 最終的に完成コードも提示しますが、意味を理解する為にも、少しづつ分解して提示してみます。 まずはデータシートを変数に格納する方法ですけど、 以下の2コードのような書き方がおそらく行儀の良いコードなんだと思いますので一応載せておきます。 Sub シート代入1() Dim sh As Worksheet Dim sh2 As Worksheet Dim shName Dim i As Long shName = Array("4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "1月", "2月", "3月") For i = 0 To 11 For Each sh2 In Worksheets If sh2.Name = shName(i) Then Set sh = sh2 Exit For End If Next sh2 Next i End Sub Sub シート代入2() Dim sh As Worksheet Const shName = ",4月,5月,6月,7月,8月,9月,10月,11月,12月,1月,2月,3月," Dim i As Long For Each sh In Worksheets If i < InStr(shName, "," & sh.Name & ",") Then i = InStr(shName, sh.Name) End If Next sh Set sh = Sheets(Replace(Mid(shName, i, 3), ",", "")) End Sub ですが私はめんどくさがりなので、シートが見つからなかったらエラーになるのを利用して、以下のような書き方が多いです。 Sub シート代入3() Dim sh As Worksheet Dim i As Long On Error Resume Next For i = 4 To 15 Set sh = Sheets(IIf(i > 12, i - 12, i) & "月") Next i On Error GoTo 0 End Sub （sy） 2018/04/12(木) 22:43 ---- 上記で取得したシート名を使って最新シートのデータを移行させるコードは以下になります。 (コードは上記のも含めて、標準モジュールにコピペして下さい) まだこれはブックの指定を行ってないので、対象がActiveWorkookになるので動作的には不安定です。 ただ眠いので今日は此処までと言う事で。 Sub test3() Dim shDB As Worksheet Dim shDT As Worksheet Dim fRng As Range Dim r As Range Dim s As String Dim i As Long Set shDB = Sheets("DB") On Error Resume Next For i = 4 To 15 Set shDT = Sheets(IIf(i > 12, i - 12, i) & "月") Next i On Error GoTo 0 For Each r In shDT.UsedRange.Columns(1).Cells.Offset(1).SpecialCells(xlCellTypeVisible) Set fRng = shDB.Range("A:A").Find(r.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If fRng Is Nothing Then r.EntireRow.Copy shDB.Range("A" & Rows.Count).End(xlUp).Offset(1) Else s = fRng.Address Do fRng(, "AI").Value = r(, "X").Value fRng(, "BP").Value = r(, "AE").Value fRng(, "BS").Value = r(, "AF").Value fRng(, "BW").Value = r(, "AJ").Value Set fRng = shDB.Range("A:A").FindNext(fRng) Loop Until fRng.Address = s End If Next r End Sub （sy） 2018/04/12(木) 22:59 ---- すみません、同期と共用で使ってたので ハンネをそのままで載せてしまいました! 交代で仕事しているような形ですので 実質同じExcelを触ってます。 情報不足で申し訳ございませんでした。 （きれいこさん） 2018/04/13(金) 09:28 ---- ＞キー列がA列から移動する事もあるんですか? 同期に確認を取ったところ、 A列は動くことは恐らくないが それ以降のセルが動く可能性があり、 一度わかりやすいA列が動く場合のコードを質問し それに当てはめて別でマクロを組もうと考えていたとのことでした。 A列が動くことはございません。 （きれいこさん） 2018/04/13(金) 13:34 ---- >いつも操作する際はマクロブックも実データ入りのブックもデスクトップに落として操作してます! 操作する時はファイルを移動させていると言う事でしょうか? 移動ならまだ良いですが、コピペしてるなら止めた方が良いです。 理由は、コピペの場合は忘れてしまえば、デスクトップ上のファイルは更新されているけど、 元ファイルは昔のままと言うような事が発生するからです。 中身を開かないと更新してるか分からない複製ファイルを幾つも作るのは事故の元です。 またそう言う複製を使ってると、開いている時は本当に対象のファイルなのか、確認し辛いと言うのもあります。 間違ったファイルに実行してしまったと言う事も想定されます。 予め開いて作業と言うのは問題ありませんが、バックアップ以外の複製ファイルが存在するのは、 事故を誘発する原因になるだけで、逆にメリットは一つも無いので、絶対に止めた方が良いです。 （sy） 2018/04/14(土) 23:28 ---- >もし可能であれば今回のものもFindメゾットで項目名指定ができるといいなと思います。 >その場合項目名はまたお伝えします! これは、X,AE,AF,AJの転記元の列の事を指してるのでしょうか? それとも、AI,BP,BS,BWの転記先の列の事を指してるのでしょうか? 或いはその両方とかですか? 特に難しい事ではないですが、項目名を検索する行は別スレで記載のあった2行目ですか? 以下の情報を教えて下さい。 検索したい項目名。 DB側だけなのか、転記元だけなのか、その両方なのか、と言う事。 検索する行番号。(DB側、転記元で行が違うなら、分かるようにして下さい) 別の列で同じ項目名が存在しないか。(これが一番重要) (DB側のX列は初めに丸ごとコピペするので、AI列と同じデータになると思いますが、項目名も同じですか?) （sy） 2018/04/14(土) 23:45 ---- 取り合えず、項目名検索なしの、列番号指定の転記マクロの完成形です。 段階的に説明をと思いましたが、私が説明しきれなさそうだったので、すいません。 ある程度分かるようにコメントをつけています。 分からない部分は聞いて下さい。 csvから先月シートへのデータ転記用のマクロは出来てると言う事なので、本コードではその記述はありません。 動作に問題なければ、効率などは別にして、ご自身の作ったコードが一番理解されている筈なので、 そのまま使用する事をお勧めします。 (ご自身でコードを改良する為の質問は積極的にした方が良いですよ。) 「DB2018.xlsx」と言った名前のファイルを想定しています。 ('ブック名を変数に格納 の部分で名前を取得してるので、それを実際のファイル名に変更して下さい。) Sub test4() Dim wbDB As Workbook Dim shDB As Worksheet Dim shDT As Worksheet Dim fRng As Range Dim r As Range Dim s As String On Error GoTo err1 'ブック名を変数に格納 s = "DB" & IIf(Month(Now()) < 5, Year(Now()) - 1, Year(Now())) & ".xlsx" 'ブックが開いている時は変数に格納 On Error Resume Next Set wbDB = Workbooks(s) '開いているブックがマクロブックと違う保存先の時は強制終了 If wbDB.Path <> ThisWorkbook.Path Then Application.DisplayAlerts = False wbDB.Close Set wbDB = Nothing Application.DisplayAlerts = True End If 'ブックが開いていない時は、開いて変数に格納 Set wbDB = Workbooks.Open(ThisWorkbook.Path & "\" & s) On Error GoTo err1 '年度替わりなどでブック作成忘れの時は実行しない If wbDB Is Nothing Then MsgBox "新しいDBファイルを作成して下さい!" Exit Sub End If On Error GoTo err2 'DBシートを変数に格納 Set shDB = wbDB.Sheets("DB") '先月シートを変数に格納 On Error Resume Next s = IIf(Month(Now()) = 1, 12, Month(Now()) - 1) & "月" Set shDT = wbDB.Sheets(s) On Error GoTo err2 '先月シート作成忘れの時は実行しない If shDT Is Nothing Then MsgBox s & "シートを作成して下さい!" Exit Sub End If On Error GoTo err3 '先月シートのA列をキーにフィルタリングされているデータだけループ For Each r In shDT.UsedRange.Offset(1).Columns(1).SpecialCells(xlCellTypeVisible) '先月シートのAretu woキーにDBシートのA列で同じキーを検索 Set fRng = shDB.Range("A:A").Find(r.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If fRng Is Nothing Then '検索結果が無ければ、1行丸ごとDBシートの新規レコードとして転記 r.EntireRow.Copy shDB.Range("A" & Rows.Count).End(xlUp).Offset(1) Else '検索結果があればそのアドレスを記憶 s = fRng.Address 'ループで1～複数個の検索結果があれば、X,AE,AF,AJ列をAI,BP,BS,BW列に転記 Do fRng(, "AI").Value = r(, "X").Value fRng(, "BP").Value = r(, "AE").Value fRng(, "BS").Value = r(, "AF").Value fRng(, "BW").Value = r(, "AJ").Value Set fRng = shDB.Range("A:A").FindNext(fRng) '再検索で同じアドレスに戻ればループ終了 Loop Until fRng.Address = s End If Next r Exit Sub 'ここからはエラー処理(作成途中には無い方が良いです) '完成形では、万が一のエラー時に、合った方がデバッグ作業の時に便利です。 'エラー番号や内容は、ネットで検索すればある程度分かります。 '(デバッグ自体は経験は必要ですが) err1: MsgBox "ブックを変数に格納中にエラーが発生しました!" & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation Exit Sub err2: MsgBox "シートを変数に格納中にエラーが発生しました!" & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation Exit Sub err3: MsgBox "データ転記中にエラーが発生しました!" & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation End Sub 一か所不具合があったので修正しました。(8:58) （sy） 2018/04/15(日) 00:21 ---- syさん お返事遅くなりまして、申し訳ないです:( コードのご提示、ありがとうございました。 ちょっと仕事が忙しくて 今週はゆっくり見れそうにありません。 来週半ばあたりに ゆっくり見てみます! 不明点などはまたお伺い致しますので ぜひ宜しくお願い致します。 （きれいこさん） 2018/04/19(木) 09:23 ---- 時間があったので、、、 ＞いつも操作する際はマクロブックも実データ入りのブックもデスクトップに落として操作してます! 操作する時はファイルを移動させていると言う事でしょうか? 移動ならまだ良いですが、コピペしてるなら止めた方が良いです。 理由は、コピペの場合は忘れてしまえば、デスクトップ上のファイルは更新されているけど、 元ファイルは昔のままと言うような事が発生するからです。 中身を開かないと更新してるか分からない複製ファイルを幾つも作るのは事故の元です。 またそう言う複製を使ってると、開いている時は本当に対象のファイルなのか、確認し辛いと言うのもあります。 間違ったファイルに実行してしまったと言う事も想定されます。 予め開いて作業と言うのは問題ありませんが、バックアップ以外の複製ファイルが存在するのは、 事故を誘発する原因になるだけで、逆にメリットは一つも無いので、絶対に止めた方が良いです。 →なるほど、、、アドバイスありがとうございます。 共有ファイル上で操作すると体感動作がとても遅く感じ、 そのようにしてました。 複製ファイルは作らないようにします! ありがとうございます。。。 ＞もし可能であれば今回のものもFindメゾットで項目名指定ができるといいなと思います。 ＞その場合項目名はまたお伝えします! これは、X,AE,AF,AJの転記元の列の事を指してるのでしょうか? それとも、AI,BP,BS,BWの転記先の列の事を指してるのでしょうか? 或いはその両方とかですか? 特に難しい事ではないですが、項目名を検索する行は別スレで記載のあった2行目ですか? 以下の情報を教えて下さい。 検索したい項目名。 DB側だけなのか、転記元だけなのか、その両方なのか、と言う事。 検索する行番号。(DB側、転記元で行が違うなら、分かるようにして下さい) 別の列で同じ項目名が存在しないか。(これが一番重要) (DB側のX列は初めに丸ごとコピペするので、AI列と同じデータになると思いますが、項目名も同じですか?) →項目名は別スレで出していたかもしれませんが、多少変更があったので 改めてお伝えします(-_-;) ＞検索したい項目名 転記元X,AE,AF,AJは不動のため項目名なし。 セル行名で指定。 DB:転記先AI,BP,BS,BWは移動する可能性があったため2列目に項目名をいれ、Findで検索。 項目名 AI:契約区分 BP:契約締結日付 BS:事由 BW:現ステータス 例）転記元をコピーし転記先の続きに貼り付ける Sheets("まとめシート").Select Set FoundCell = Range("2:2").Find(What:="顧客コード2") N = Cells(Rows.Count, FoundCell.Column).End(xlUp).Row + 1 Cells(N, FoundCell.Column).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ＞DB側だけなのか、転記元だけなのか、その両方なのか、と言う事。 DBのみに項目名が割り振られています。 ＞検索する行番号。(DB側、転記元で行が違うなら、分かるようにして下さい) 転記元 転記先:項目名 X, → AI:契約区分 AE, → BP:契約締結日付 AF, → BS:事由 AJ, → BW:現ステータス ＞別の列で同じ項目名が存在しないか。 マクロブックと実データ入りブックの構成は完璧に同じです。 まとめシート(DB)内で項目の重複はありません。 (これあったら検索できないですもんね((+_+))) 月末近づいてきて忙しいですが ご回答は余裕のある時で問題ないです! 何卒よろしくお願い申し上げます。。。 （きれいこさん） 2018/04/19(木) 11:16 ---- >＞別の列で同じ項目名が存在しないか。 >まとめシート(DB)内で項目の重複はありません。 重複が無いなら、別スレでも提示のあったMatch関数が使えますね。 >(これあったら検索できないですもんね((+_+))) 重複があっても、例えば必ず右側を取得とかなら、Findメソッドやループで検索可能です。 要はマクロにしたい処理をルール化出来るかどうかです。 どんなに複雑な動作でも、ルール化出来るならマクロで記述可能です。 逆に言えばどんなに簡単な事でも、ルール化出来ないような気まぐれな動作はマクロ化出来ません。 >共有ファイル上で操作すると体感動作がとても遅く感じ、 うちの会社でも自作システムなどでは、同じ不満はよく言われます。 (PCからの起動と比べて最大5倍くらい遅い時があるので) ですがデータの不整合が出て気付かないで後でクレームとかになるよりは、 使う人の慣れだけの問題なので、我慢してもらってます。 後これは余談ですが、別スレの長い式ですけど、以下で良いですよ。 =LEFT(RC[1]&RC[2]&RC[71]&RC[72]&RC[73]&RC[78]&RC[79], FIND("月", RC[1]&RC[2]&RC[71]&RC[72]&RC[73]&RC[78]&RC[79]&"月")-1) 以下がまとめシートの項目列が可変になったコードです。 DB側のシートを「DB」シートとしていましたが、今回から「まとめシート」に修正しました。 ブック名は分からないので、コードを修正して下さい。 Sub test5() Dim wbDB As Workbook Dim shDB As Worksheet Dim shDT As Worksheet Dim fRng As Range Dim Col As Variant Dim r As Range Dim s As String Dim i As Long 'ブック名を変数に格納 s = "DB" & IIf(Month(Now()) < 5, Year(Now()) - 1, Year(Now())) & ".xlsx" 'ブックが開いている時は変数に格納 On Error Resume Next Set wbDB = Workbooks(s) '開いているブックがマクロブックと違う保存先の時は強制終了 If wbDB.Path <> ThisWorkbook.Path Then Application.DisplayAlerts = False wbDB.Close Set wbDB = Nothing Application.DisplayAlerts = True End If 'ブックが開いていない時は、開いて変数に格納 Set wbDB = Workbooks.Open(ThisWorkbook.Path & "\" & s) '年度替わりなどでブック作成忘れの時は実行しない If wbDB Is Nothing Then MsgBox "新しいDBファイルを作成して下さい!" Exit Sub End If On Error GoTo err1 'DBシートを変数に格納 Set shDB = wbDB.Sheets("まとめシート") On Error GoTo err2 '先月シートを変数に格納 s = IIf(Month(Now()) = 1, 12, Month(Now()) - 1) & "月" Set shDT = wbDB.Sheets(s) On Error GoTo err3 'まとめシートの転記先列を取得 Col = Array("契約区分", "契約締結日付", "事由", "現ステータス") For i = 0 To 3 Col(i) = WorksheetFunction.Match(Col(i), shDB.Range("2:2"), 0) Next i On Error GoTo err4 '先月シートのA列をキーにフィルタリングされているデータだけループ For Each r In shDT.Range("A1", shDT.UsedRange).Offset(2).Columns(1).SpecialCells(xlCellTypeVisible) '先月シートのAretu woキーにDBシートのA列で同じキーを検索 Set fRng = shDB.Range("A:A").Find(What:=r.Value, LookIn:=xlValues, _ LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If fRng Is Nothing Then '検索結果が無ければ、1行丸ごとDBシートの新規レコードとして転記 r.EntireRow.Copy shDB.Range("A" & Rows.Count).End(xlUp).Offset(1) Else '検索結果があればそのアドレスを記憶 s = fRng.Address 'ループで1～複数個の検索結果があれば、X,AE,AF,AJ列をAI,BP,BS,BW列に転記 Do fRng(, Col(0)).Value = r(, "X").Value fRng(, Col(1)).Value = r(, "AE").Value fRng(, Col(2)).Value = r(, "AF").Value fRng(, Col(3)).Value = r(, "AJ").Value Set fRng = shDB.Range("A:A").FindNext(fRng) '再検索で同じアドレスに戻ればループ終了 Loop Until fRng.Address = s End If Next r Exit Sub 'ここからはエラー処理(作成途中には無い方が良いです) '完成形では、万が一のエラー時に、合った方がデバッグ作業の時に便利です。 'エラー番号や内容は、ネットで検索すればある程度分かります。 '(デバッグ自体は経験は必要ですが) err1: If Err.Number = 9 Then MsgBox "まとめシートが無いか、シート名が適切ではありません!" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation Else MsgBox "まとめシートを変数に格納中にエラーが発生しました!" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation End If Exit Sub err2: If Err.Number = 9 Then MsgBox s & "シートを作成して下さい!" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation Else MsgBox s & "シートを変数に格納中にエラーが発生しました!" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation End If Exit Sub err3: MsgBox "項目名「" & Col(i) & "」が見つかりません!" & vbLf & _ "消去または変更されていないか確認して下さい。" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation Exit Sub err4: MsgBox "データ転記中にエラーが発生しました!" & vbLf & vbLf & _ "エラーNo. :" & Err.Number & vbLf & _ "エラー内容:" & Err.Description, vbExclamation End Sub （sy） 2018/04/21(土) 10:47... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201804/20180403165201.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97055 documents and 608272 words.
訪問者：