• ベストアンサー

繰返し計算の高速化の方法をご指南願います

いつも大変お世話になり有難うございます。 VBA初心者です。 早速ですがお尋ねします。 VBAで毎回条件変えて繰返すプログラムを作りましたが終了まで数時間かかり困ってます。 プログラムの全体の流れは、 約25000個のデータをあるパラメータで計算→計算結果とその時のパラメータをセル(i、1~9)に記入→パラメータを変更→約25000個のデータをあるパラメータで計算→計算結果とその時のパラメータをセル(i+1、1~9)に記入→・・・ というものです。繰り返し回数は1万回前後です。パラメータをもとに計算する式は簡単な加減則で、文字数の都合もあり割愛いたします。 試行錯誤の結果、 1.繰り返し計算の途中にある以下の多くのセル記入文の部分 2.1列目のセルに(IF(C77=100,"測定終了",IF(C77-J77>0,"下降","上昇")))、(IF(C78=100,"測定終了",IF(C78-J78>0,"下降","上昇")))・・・の式が約25000行に渡りは入っている事 3.2~4列目に時間、測定データ1、測定データ2が約25000個ずつセルに入っている事 がネックと分かりました(ファイル容量約3MB)。 Q1、以下のセル記入方法を改善して高速化できる方法があればご指南いただけないでしょうか? なおセルへの記入はWorksheets(1)にあるグラフに使用するのと、記入されたデータを後でソートして傾向を見るためのものです。また以下Rangeの値は一回の計算毎に変化するものです。 Range("J74") = Application.WorksheetFunction.Sum(Range("J76:J30000")) Range("K74") = Application.WorksheetFunction.Sum(Range("K76:K30000")) Range("L74") = Application.WorksheetFunction.Count(Range("J76:J30000")) Range("M74") = Application.WorksheetFunction.Count(Range("K76:K30000")) Worksheets(2).Cells(i, 1).Value = i - 1 Worksheets(2).Cells(i, 2).Value = Range("J74") Worksheets(2).Cells(i, 3).Value = Range("K74") Worksheets(2).Cells(i, 4).Value = Range("L74") Worksheets(2).Cells(i, 5).Value = Range("M74") Worksheets(2).Cells(i, 6).Value = Range("B32") Worksheets(2).Cells(i, 7).Value = Range("B33") Worksheets(2).Cells(i, 8).Value = Range("B31") Worksheets(2).Cells(i, 9).Value = Range("B34") Q2、(IF(C77=100,"測定終了",IF(C77-J77>0,"下降","上昇")))・・・、の式によりプログラムが遅くならない方法は考えられるでしょうか?(一回の計算毎に”下降””上昇”の数をcountしているため計算無効にすると困ります) Q3、時間と測定データ1,2は繰返し計算のプログラムで使用する元データのため消してはまずいのですが、データの多さがプログラム速度に悪影響与えない方法はあるでしょうか? 画面更新無効などは設定しています。 winXP、excel2002、cpu2.4GHz、RAM1GB、です。 字数の都合で前後式は省略してます。すみません。 ネットや書籍で調べ、当初より多少は速度が改善されたのですが、上記問題を残し力尽きてしまいました。 質問のうち一つでも結構ですので、ご指南よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • pulsa
  • ベストアンサー率57% (34/59)
回答No.2

初心者と言ってますが、そうでもないですよね 処理の高速化にあたり、画面の更新が処理の足を引っ張る事に行き着くのは、そうたやすい事では無いと思います 相当努力されたのでしょう さて本題 画面の更新を止める事により処理が高速化するのは、つまり画面の描画には時間が掛かる事を意味しています 逆に画面に変化を起こさせ無ければ処理を高速化させる事ができます セルへの入力は文字を表示させる以外にフォントや書式、罫線など計算処理に不要な項目が多く含まれる為、ただ文字を表示させただけでも、エクセル上では複雑な処理が発生しています 画面の更新を止める事で、再描画に必要なリソースを節約できるのですが、逆に言うと表示していないだけで、画面の再描画が命令されたときすぐに表示できるように、画面に現れないだけで、裏ではセルに値を書き込みに行っています この書き込み処理自体を減らす事で、更なる高速化が可能です こちらをお試し下さい   Dim iCnt As Integer   For iCnt = 1 To 32000     Range("A1") = Range("A1") + 1   Next iCnt 次にこちらをお試し下さい   Dim iCnt As Integer   Dim jCnt As Integer   For iCnt = 1 To 32000     jCnt = jCnt + 1   Next iCnt   Range("A2") = jCnt 同じ内容を実行しているのに、その処理時間の違いに驚くハズです 画面の更新を停止しても、上の処理が下の処理と遜色無いレベルには到底なりません このように、一旦値を変数に格納して処理し、最後書き出すようにするだけで、劇的に高速化します 次に、配列はご存知ですか? 配列自体はここで説明できるほど浅くないので、説明はネットを色々見て体得していただくとして、今回の処理に利用することで言うと、2次配列はそのままエクセルシートと対応させる事ができるので、上の例と同様、毎回行っているセルへ書き出す処理を配列を使用して計算させ、最後一気にシートに出力させる事で、処理の高速化が望めます こちらを試してください   Dim iCnt As Integer   Dim jCnt As Integer   For iCnt = 1 To 100     For jCnt = 1 To 100       Cells(iCnt, jCnt) = iCnt + jCnt     Next jCnt   Next iCnt 次にこちらを試して下さい   Dim iCnt As Integer   Dim jCnt As Integer      Dim MyCellR(1 To 100, 1 To 100)   For iCnt = 1 To 100     For jCnt = 1 To 100       MyCellR(iCnt, jCnt) = iCnt + jCnt     Next jCnt   Next iCnt   Range(Cells(1, 1), Cells(100, 100)) = MyCellR ポイントは配列を (1 to 100)と1から作成している所で、通常は配列のインデックスは0から始まるのですが、それを1から始める事でセルの変わりに利用する利便性を上げています 最後に各セルに入れてある関数を解決します Evaluateメソッドを利用します これは、平たく言うとセルに入力するような値を文字列として入力して使う事が出来るメソッドです 使い方はこんな感じ 先ほどの実験ロジック実行後の値が入っているシートを表示した状態で試して下さい MsgBox Application.Evaluate("=SUM(A1:A100)") かっこの中は文字列で、上記の体裁を取っていればOKですので、今関数が入っているセルを直接指定して関数的に利用する事が出来ます (Range("J74")に関数が入っていると仮定して) MsgBox Application.Evaluate(Range("J74")) これら、配列+Evaluate でロジックを組みなおせば、かなり高速化できると思います 示されたコードでは、ロジックを組むには情報が足りませんので、具体的なコードは示せませんが、手法としてはこんな感じで高速化が可能です 配列は、逆に言うと処理状況の確認が難しくなるので、最初戸惑うかもしれませんが、ようは画面に出さないシートと思って使えばイメージしやすいと思います(Cells(1,1)=MyCellR(1,1)と脳内補完する) 画面の更新やシートをSelectせずに利用する方法に行き着けたあなたならきっと出来ます がんばって!!

bigfoot777
質問者

お礼

返答遅くなりすみません。 良質な実用書のようなご回答有難うございます。 最後に激励までして頂き感動です。VBAは興味持ち出し1年未満で、且つ我流なため自信なかったのですが、とても励みになりました。 今まで悶々としていた問題が解決できると思うと、ご回答内容を見ているだけでワクワクしてきます。 本題ですが、  画面更新を止めても裏では表示準備しているため結構負荷は残っているのですね。なるほど理解が深まりました。早速サンプルプログラムで検証させて頂きます。  配列に関しては、データ数が多いとき高速化に有効ということをネットで見た程度で「ところで、配列はどうやって使用するの・・・?」という印象でした。なので、この配列のサンプルプログラムも大変参考になります。これを機に何とか使えるようにしたいと思います。  ここまでのイメージとして、Range("**")に替わるプログラム方法を用いることでPCは計算のみに集中、最後にまとめて表示で高速化、という様なかんじでしょうか。  evaluateメソッド・・。手元のVBA参考書には載ってないです。本当に勉強になります。ちょっとまだ私の力量不足で、evaluateのイメージが沸いてきませんが、ご回答文章を呼び水にして調べてみたいと思います。 私の質問文が内容不足にも関わらず、非常に的確なご回答有難うございます。(まるで私の後ろからプログラムを実際に見ながらアドバイスもらっているかのようで、不思議な感覚でした) 多少時間を要しそうですが検証結果は追って報告させて頂きます。では失礼致します。

bigfoot777
質問者

補足

どうやら質問を締め切ると結果報告はできなさそうです・・。すみません。今回はどうも有難うございました。

その他の回答 (2)

  • Harusir
  • ベストアンサー率0% (0/2)
回答No.3

ロジカル的な解決方法は他の回答にまかせるとして、処理中はエクセルを最小化しておき、処理が終了後に元に戻す事で、速度向上に繋がります。一度試して見てください。 'ワークブックを最小化 ActiveWindow.WindowState = xlMinimized '~処理を記述 'ワークブックを最大化 ActiveWindow.WindowState = xlMaximized

参考URL:
http://www.happy2-island.com/excelsmile/smile03/capter00306.shtml
bigfoot777
質問者

お礼

ご回答有難うございます。 この方法は知りませんでした。 これだけで簡単に高速化できるのですね。 是非試してみたいと思います。 どうもありがとうございました。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.1

1 関数の入ったセルが多数あるため、その再計算で時間がかかっていると思います。質問のデータだけでは関数の入力されたセルを減らしたり、再計算しなくてすむのかどうかを判断できません。これを減らすことが決定的と思います。 2. セルへの書き込み回数が多いかもしれません。セルへの逐次書き込みを減らせれば速度は向上します。

bigfoot777
質問者

お礼

返答遅くなり申し訳ありません。 ご回答ありがとうございます。 詳細までプログラムを書いてなくて申し訳ございません。 仰るとおりセルに入力された関数と、逐次書き込みが高速化のネックになっていることは確かです(正しい計算結果は出力されなくなりますが、試しにセル内の関数や逐次書き込み文を消去してプログラム走らせると、3割程度計算時間が短縮されます)。正しい計算結果をだしつつこれらの処理を減らす方法も考えていきたいと思います。どうも有難うございました。

関連するQ&A

  • コピペマクロを高速化したい(Excel)

    見よう見まねで以下のようなコードを書いてみたのですが、 これだと表示にやや時間がかかるので改善したいです。 ------ Sub コピペ() Dim i As Long i = Range("A1") Range("C12").Value = Worksheets("sheet2").Cells(i, 2).Value Range("D12").Value = Worksheets("sheet2").Cells(i, 3).Value Range("E12").Value = Worksheets("sheet2").Cells(i, 4).Value Range("F12").Value = Worksheets("sheet2").Cells(i, 5).Value Range("G12").Value = Worksheets("sheet2").Cells(i, 7).Value ------ こんな感じでコピペしたい値があと15個くらいあります。 コピー元とコピー先のセル配置には法則性があまりありません。 よろしくお願いします。

  • データの抽出 と計算 表示

    Excel2007でVBAを使ってマクロを作っています。現在、ある表から特定の条件を満たした行の値の平均を別シートに表示させようとしているのですが、条件文のところでエラーが出てしまいます。原因がまだ初心者なもので?です。是非ご教授のほどお願いします *抽出はif文で、計算はいったん値をすべて合計して、その合計値を個数で割るという効率の悪いやり方をしています。変数はすべてintegerです /////////////////////////////////////////////////////////////// ・ ・ ・ i = 3 Worksheets("Sheet1").Activate Do While i < 150 ↓ここでエラーが出ます↓ If Worksheets("Sheet1").Range(Cells(i, 2)).Value = "02701?" Or "02730?" Then erea1 = Range(Cells(i, 4)).Value + erea1 cou1 = cou1 + 1 ・ ・ ・ j = 1 k = 63 Do While j < 13 ereaj = ereaj / couj Worksheets("Sheet2").Range(Cells(k, 5)).Value = ereaj j = j + 1 k = k + 2 Loop *表示は省略します* //////////////////////////////////////////////////////////////

  • 別のシートを参照して計算する方法

    質問です。 シート1に数値が入力してあり、そこで計算した結果をシート2に貼り付けるにはどのようにすればいいのでしょうか? Worksheets("シート2").Cells(3 + g, 3 * c) = _ Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) と書いたのですが、上手くいきません。 おそらく Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) の部分がおかしいと思うのですが、どうすればよいでしょうか? よろしくお願いします。

  • マクロif文での条件式について

    マクロ初心者です。Excel2003を使用しています。 仕事上で使用しているエクセル表より、ある値以上の項目を抽出し、その値を用いて計算結果を出すためのマクロを作成いたしました。いろいろなサイトを参考にして自分なりに書いてみたのですが、どうしてもうまくいきません。 表は簡単なもので、以下のようなものです。 1 9 2 24 3 45 4 67 1列目は使用濃度、2列目は測定値です。この測定値が30より大になった項目を抽出し、計算式にその値を代入し計算結果として出したいのです。また、全ての測定値が30以下だった場合は、計算結果の欄に”<30”とのように表示をさせたいと考えています。 以下のようにマクロを書いてみました。 Sub Macro1() For i = 1 to 4 if Worksheets("sheet1").cells(i , 2).value <=30 then Range("A5")=0 '測定値が=<30だった場合は計算をしないので、フラグとして値を入力 Elseif Worksheets("sheet1").cells(i , 2).value > 30 then Range("A5")=Cells(i , 1) Range("B5")=Cells(i , 2) Exit for Endif if Worksheets("sheet1").Range("A5").value > 0 then Range("A6").Formula ="=(50-B5) / A5" Elseif Worksheets("sheet1").Range("A5").value = 0 then Range("A6") ="<30" Else Endif Next i End Sub >30だった項目の抽出まではできたのですが、計算値をだすところがどうしてもうまくいかず、A6セルにはどんな値でも”<30”と入力されてしまいます。 マクロの基本的なルールなどがまだまだ未熟なので、基本的な構文も書けていないと思います。 全然方向性が違うかもしれないので、そういった点も含めてご教示いただけたら幸いです。 分かりにくいかもしれませんが、どうぞよろしくお願いいたします。

  • 表計算

    Sub TaskManager() Dim i As Integer Dim Maxval As Integer Dim Counter As Integer Dim AtoShoriFlg As String Set SH1 = Worksheets("Sheet1") Set SH2 = Worksheets("Sheet2") Maxval = WorksheetFunction.Max(Range("B:B")) Maxval = Maxval + 1 '初期値設定 i = 7 AtoShoriFlg = "ON" Counter = 1 Do While Cells(i, 4).Value <> "end" Select Case Cells(i, 4) Case Is = "新規エントリー" AtoShoriFlg = "OFF" i = i + 1 Case Is = "" Cells(i - 1, 4).Copy Cells(i, 4) Cells(i, 4).Font.Color = RGB(255, 255, 255) SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone Case Is <> Cells(i - 1, 4) SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Font.Color = RGB(0, 0, 0) If Cells(i, 2) = "" Then Cells(i, 2) = Maxval Maxval = Maxval + 1 End If Counter = 1 Case Else SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone End Select If Cells(i, 2).Value = "" Then Cells(i, 2) = Cells(i - 1, 2).Value Cells(i, 2).Font.Color = RGB(255, 255, 255) End If If Cells(i, 3).Value = "" And Counter <> 1 Then Cells(i, 3) = Cells(i - 1, 3).Value Cells(i, 3).Font.Color = RGB(255, 255, 255) End If If AtoShoriFlg = "ON" Then Cells(i, 7) = Counter Counter = Counter + 1 End If i = i + 1 Loop SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous If AtoShoriFlg = "ON" Then SH2.Range("B2:F5").Copy Destination:=SH1.Cells(i, 2) End If End Sub

  • エクセルで複数のシートに罫線を引くマクロを教えてください。

    エクセルで複数のシートに罫線を引くマクロを教えてください。 エクセルの表を担当者名でシート分割後、空白セル以外に罫線を引きたいのですが 複数シートに罫線を引くマクロを教えてください。 いくつか参考にさせていただき現状以下の様になっています。 元データというシートにAからGまで項目があります PJNo. PJ名 棟No. 棟名 取引先名  書類  担当者 1111 PJ1 10 棟1 取引先1  1 東京 1112 PJ2 11 棟2 取引先2  2 大阪 1113 PJ3 12 棟3 取引先3  3 名古屋 Sub 担当別シート作成() Application.ScreenUpdating = False For i# = 2 To Worksheets("元データ").Cells(2, 2).End(xlDown).Row j# = 1 '検索中の人のシートが既にできているかを判断する。 For Each sheet_name In Worksheets If sheet_name.Name = Worksheets("元データ").Cells(i, 7).Value Then j = 7 Exit For End If Next '検索中の人のシートがない場合、新規に作成する。 If j = 1 Then Worksheets.Add After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 7).Value For j = 1 To 7 Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value Next j End If 'データのコピー For j = 7 To 1 Step -1 Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(65535, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value Next j Next i 'それぞれのシートの列幅を最適化します。 For Each sheet_name In Worksheets sheet_name.Columns("A:G").AutoFit Next '---- Dim c As Range Range("A1").Select Set c = Selection.SpecialCells(xlCellTypeLastCell) Range(Cells(1, "A"), c).Select (省略)以下罫線を引くマクロ End Sub

  • excel VBA で条件の設定方を教えて下さい。

    今、斜線を引きその斜線データの最初のセルに数値で(1とか3とかの数値の)条件をつけて置き、その条件で、太さ、色等を変えて斜線を引きたいのですがうまくいきません。何方か教えて頂けませんか。 --------------------- dim myrange as range workheets("補助計算").range("c8:c47").value = worksheets("時刻").range("c8:c47").value workheets("補助計算").range("g8:h47").value = worksheets("時刻").range("g8:h47").value with worksheets("時刻")     v=worksheets("時刻").range("m2").value+12'描画本数     for i = 12 to v step 1'設定可能本数50本 set myrage = worksheets("補助計算").range("t3:t47") myrange.value = .range(.cells(3,i),.cells(48,i)).value for cnt = 75 to 113 step 2 e = worksheets("ダイヤ").cells(cnt,10).value       f = worksheets("ダイヤ").cells(cnt,11).value       g = worksheets("ダイヤ").cells(cnt+1,10).value       h = worksheets("ダイヤ").cells(cnt+1,11).value with worksheets("ダイヤ").shapes.addline(e,f,g,h) .line.weight = 1.1 .line.forecolor.rgb = vbblue end with next cnt next i end with ----------------------- 上記コードで、斜線が何本か引かれます、その際、データ元のセルに数値の条件、例えば、1 とか3とかの数値を入力されているときは、それによって、斜線の色、又は線の太さをかえたいのですが、指定の仕方は、時刻シートの時刻の上欄セルに、線の指定のセル、太さ指定のセルに別々に指定おき、それを参照して、線の色、太さをかえたいのですが、いろいろ試みましたがうまくいきません。上記コードにどのように追加コードをすればよいか何方か教えていただけませんか。できれば、線の色は3色以上設定できればありがたいです。、

  • vbaの速度向上(sumif関数)

    エクセルvbaの速度を向上できないか、お知恵を貸していただきたく存じます。 以下のvba(sumif関数)をもっと速めたいです。何とかできないでしょうか。長い記載となり申し訳ないのですが、何卒よろしくお願い申し上げます。 myCnt7 = 2 Do Worksheets("●").Cells(myCnt7, 4).Value = WorksheetFunction.SumIf(Worksheets("◆").Range("B:R"), Worksheets("●").Cells(myCnt7, 3), Worksheets("◆").Range("R:R")) - WorksheetFunction.SumIf(Worksheets("★").Range("B:C"), Worksheets("●").Cells(myCnt7, 3), Worksheets("★").Range("C:C")) Worksheets("●").Cells(myCnt7, 7).Value = WorksheetFunction.SumIf(Worksheets("◆").Range("B:R"), Worksheets("●").Cells(myCnt7, 6), Worksheets("◆").Range("R:R")) - WorksheetFunction.SumIf(Worksheets("★").Range("B:C"), Worksheets("●").Cells(myCnt7, 6), Worksheets("★").Range("C:C")) Worksheets("●").Cells(myCnt7, 10).Value = WorksheetFunction.SumIf(Worksheets("◆").Range("B:R"), Worksheets("●").Cells(myCnt7, 9), Worksheets("◆").Range("R:R")) - WorksheetFunction.SumIf(Worksheets("★").Range("B:C"), Worksheets("●").Cells(myCnt7, 9), Worksheets("★").Range("C:C")) Loop While myCnt7 > 201 ※シート●のC列から3列ごとに、Sumifの検索条件があります。 ※シート●のD列から4列ごとに、Sumifの計算結果を出力させます。 ※計算対象シートは、シート◆とシート★の2つです。  シート◆のSumif合計から、シート★のSumif合計を差し引いています。  Sumifの条件自体は、どちらのシートも同じ(シート●)。 ※上記のSumif関数の記述は、3つですが、実際の記述は24あります。 ※すなわち、検索条件の組み合わせが24あり、201行分をmyCnt7でLoopさせて実行しています。

  • VBAのVLOOKUPの速度向上について

    VBAでVLOOKUPの速度向上について、お知恵を貸していただきたく存じます。 以下のVLOOKUPのVBAがおそく、速くしたいです。行数は2万行ぐらいです。 何卒よろしくお願い申し上げます。 Dim 範囲A As Range Set 範囲A = Worksheets("取引先").Range("A:H") On Error Resume Next myCnt5 = 2 Do Worksheets("受注データ").Cells(myCnt5, 49).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt5, 48), 範囲A, 6, False) myCnt5 = myCnt5 + 1 If Worksheets("受注データ").Cells(myCnt5, 1).Value < 10 Then Exit Do Loop On Error Resume Next myCnt6 = 2 Do Worksheets("受注データ").Cells(myCnt6, 51).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt6, 50), 範囲A, 8, False) myCnt6 = myCnt6 + 1 If Worksheets("受注データ").Cells(myCnt6, 1).Value < 10 Then Exit Do Loop On Error Resume Next myCnt7 = 2 Do Worksheets("受注データ").Cells(myCnt7, 53).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt7, 52), 範囲A, 6, False) myCnt7 = myCnt7 + 1 If Worksheets("受注データ").Cells(myCnt7, 1).Value < 10 Then Exit Do Loop 補足 上記VBAには記載していませんが、Application.ScreenUpdatingの停止、Application.Calculationを手動の設定はしています。

  • VBA CHANGEイベントに複数イベントを

    いつもお世話になっています。 色々しらべて試してみたんですが、うまくいかないんで教えてください。 CHANGEイベントに複数のイベントを書き込みたいんですが。 今現在、問題なく動いている以下のイベントがあります。 (1) Private Sub Worksheet_Change(ByVal Target As Range) Dim rang3 As Range Dim rang4 As Range Dim ■■ As String Dim LastRow1 As Long LastRow1 = Worksheets("○○").Cells(Rows.Count, "b").End(xlUp).Row Set rang4 = Worksheets("○○").Range("b:I" & LastRow) Set rang3 = Range("h4") If Intersect(Target, rang3) Is Nothing Then Exit Sub On Error Resume Next ■■ = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) If Err.Number > 0 Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Select Else Application.EnableEvents = False Range("I4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 2, False) Range("j4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 3, False) Range("k4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 7, False) Range("l4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 8, False) Range("m4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 5, False) Application.EnableEvents = True Range("K4").Select End If End Sub このシートにもう一つ、イベントを入れたいのですが。 (2) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("E4")) Is Nothing Then Exit Sub Else If Range("e4").Value = "1" Then Target.Offset(0, 19).Value = "☆" End If どこに入れればいいのかわかりません。 (3) また、(2)のイベントの他に、 (1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。 (2)のみなら動くことは確認できましたが、(1)のexit sub の直前に入れたり、end ifの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。 (3)については、まったくわかりません。 マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。 どなたか、教えてください。 お願いします。