Worksheet_Changeが起こらない?

このQ&Aのポイント
  • fundataシートのWorksheet_Changeイベントが起こらないという問題が発生しています。
  • 手入力でFの最後を弄るとイベントが発火するが、他のシートのWorksheet_Calculateイベントでは反応しない。
  • orgdataの特定のセルにリンクされたデータを元に加工し、値が変化している。リンクで得られたデータには癖がある可能性がある。
回答を見る
  • ベストアンサー

Worksheet_Changeが 起こらない?

早速ですが fundata シートの Worksheet_Change endrh = Cells(20000, 1).End(xlUp).Row Application.EnableEvents = False 'If Target.Address = "$F$" & endrh Then ですが 手入力で F 最後を 弄ると イベントをひらうのですが 他のシート("orgdata").の Worksheet_Calculate() Worksheets("orgdata").Activate Range("a4:h4").Select Selection.Copy Worksheets("fundata").Activate Range("A2").Select Range("A20000").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlValues でデータを アペンドで 追加するのですが、その追加には 上記が反応しないのです。 また、情報として orgdata の Range("a4:h4"). は リンクで得られたデータをもとに 加工して 値が得られ、時間で変化しています。 リンクで得られたデータは 癖があるのは承知しているのですが、その口でしょうか? よろしくどうぞ

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

  • ベストアンサー
回答No.1

やりたいことの詳細は置いといて、 fundata シートの Worksheet_Change イベントの中で Application.EnableEvents = False を実行したのちに解除していないので、この Worksheet_Change イベントが 1度実行されると、Excel のイベントが発生しないようになってしまう気がする。 fundata シートの Worksheet_Change イベントの最後に Application.EnableEvents = True でイベントが発生するように戻してみては?

007itochan
質問者

お礼

恐れ入ります。 最下段なもので 割愛しました。入っています。 新しい状況では、ブレークポイントで見ると イベントひらっています。 訂正させていただいて、 条件の IF文が 働かないようです。 質問では レムってますが、いろいろ錯誤中なもので、ご容赦

007itochan
質問者

補足

お礼と補足が入れ違いになりましたが、自己レスということで target.address = 全部変化する番地 なら 通りました。 "$A$" & endhr & ":" & "$H$" & endhr then これが、仕様かどうか不明ですが, これじゃ、あそこが変化したら、こうだとか、簡単な分岐ができないな。 おまけに、全く無関係と思われる コピーメソッドの失敗とか、とんでもないとこにエラーが飛び火した。 VB6 と比べて、訳わからんです。

関連するQ&A

  • worksheetクラスのcopyメソッドが失敗しました。

    VBA初心者です。 「worksheetクラスのcopyメソッドが失敗しました。」 エラー回避方法を教えてください。 やりたいことは、データ入力シートから雛形シートにデータを参照して、データ入力シートの1行ずつを新しいシートにしたいです。35シートぐらいをコピーしたら上記のエラーがでました。メモリ不足でエラーになるんだろうなぁということは予測つくのですが、なにか回避方法はありますか? 別のブックを使う方法でもよいです。ご教示ください。 コードはこんな感じです。 Sub シート作成1() 'データ行選択 Range("B9").Select Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Unprotect Rows("8:8").Select Selection.AutoFilter Selection.AutoFilter Field:=12, Criteria1:="<>" Range("B9").Select Range(Selection, Selection.End(xlDown)).Select '選択したデータ行のシート作成 For Each 選択セル In Selection Worksheets("ひな形").Copy after:=ActiveSheet DoEvents 'シート名の変更 ActiveSheet.Name = 選択セル.Value ActiveSheet.Tab.ColorIndex = 38 Next 選択セル DoEvents 'オートフィルタを元にもどす Sheets("データ入力シート").Select Rows("8:8").Select Selection.AutoFilter Range("B1").Select Columns("L:O").Select Selection.EntireColumn.Hidden = True Range("B1").Select ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowSorting:=True, AllowFiltering:=True End Sub よろしくおねがいします。

  • オートフィルタで抽出したデータをVBAで貼り付けしたい

    質問させていただきます。 エクセルで仕入帳を作っています。 各取引先ごとに1枚のシートになっているのですが、 該当する月をオートフィルタで抽出して、そのデータを1枚のシートに貼り付けていき、各月ごとにデータをまとめたいと思っています。 ユーザーフォームで月を入力してオートフィルタで抽出しているのですが、データのないシートの場合不要な部分までコピー&ペーストされてしまいます。 これを回避するにはどのようにコードをかけばいいのでしょうか。 よろしくお願い致します。 現在はこのようなコードで抽出しています。 Private Sub CommandButton1_Click() Application.ScreenUpdating = False Worksheets("sheet2").Select Range("H1:H17").Select Range("H17").Activate Selection.AutoFilter Field:=8 Rows("2:2").Select Rows("2:500").Select Selection.ClearContents RowIndex = 3 '行番号の初期値設定 Do While Worksheets("目次").Cells(RowIndex, 1).Value <> "" '拾ったセルの値が空でない間ループ内の処理をする 検索値 = UserForm1.TextBox1.Text DataSheetName = Worksheets("目次").Cells(RowIndex, 1).Value Worksheets(DataSheetName).Select Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.AutoFilter Selection.AutoFilter Field:=13, Criteria1:=検索値 & "月分" Set tbl = ActiveCell.CurrentRegion tbl.Offset(2, 0).Resize(tbl.Rows.Count - 2, tbl.Columns.Count).Select Selection.Copy Worksheets("sheet2").Select IRow = Range("A" & Rows.Count).End(xlUp).Row Range("A" & IRow + 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Worksheets(DataSheetName).Select Selection.AutoFilter Field:=13 RowIndex = RowIndex + 1 '行番号カウントアップ Loop Application.ScreenUpdating = True Worksheets("sheet2").Select Range("A2").Select Unload UserForm1 End Sub

  • マクロを使ったコピペがうまく動作しない。

    あるデータを転記用のブック(月毎にシートが分かれています。シートの内容は同一)に貼り付ける処理を行うため、下記のようなマクロを組んだのですが、何故か貼りつきません。処理終了時には、転記元ブック(シート)で最終処理の範囲(5番目のB287)を選択しています。一体何がいけないのでしょうか? データはA1からPまでで毎月可変しています。 また、転記用ブックが12枚あるため、月を指定してから貼り付けたいのですが、どのようにすればよいでしょうか?(下記は直接シ-トを指定しました) Sub test() Dim 最終行 As Integer '-------------------------------------------- 開始 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("1").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B1").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 1 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("2").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B83").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 2 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("3").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B157").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 3 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("4").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B227").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 4 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("5").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B287").PasteSpecial Paste:=xlPasteValues --------------------------------------------- 5 End Sub 

  • Worksheet_Changeについて

     特定のマクロの前後でWorkSheet_Changeを終了し再開させる方法がありましたらお願い致します。 Windows7 SP1 Office2010 Private Sub WorkSheet_Change(ByVal Target As Range) Dim c As Range For Each c In Target Select Case c.address(0, 0) Case "C1" If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub '検査範囲 Application.EnableEvents = False '再帰実行の停止 If Range("C1").Value <> Sheets("祝祭日").Range("A1").Value Then MsgBox ("祝日の設定を反映するため年度を同じにしてください。") End If Application.EnableEvents = True Case Else Select Case c.address(0, 0) Case "G1" If Range("G1") = 4 Then '4月データの表示 Dim ret As Integer ret = MsgBox(Format(ActiveSheet.Range("G5").Value, "ge年mm月") & "の勤務割表の編集&入力保存データを元に表示します。" & vbCrLf & "よろしいですか?", _ vbOKCancel + vbQuestion, "勤務割表表示切替確認") Select Case ret Case vbOK UserForm8.Show vbModeless UserForm8.Repaint 当月データのクリア メインデータの復元4月 編集データの復元4月 Sheets("メイン・1").Select Unload UserForm8 Sheets("メイン・1").Range("G1").Select ActiveCell.FormulaR1C1 = "4" ※ ここで終了ないし一時停止 図形の貼付け ※ここで再開させたいのですが? Case vbOKCancel Exit Sub End Select ElseIf Range("G1") = 5 Then '5月データの表示 ret = MsgBox(Format(ActiveSheet.Range("G5").Value, "ge年mm月") & "の勤務割表の編集&入力保存データを元に表示します。" & vbCrLf & "よろしいですか?", _ vbOKCancel + vbQuestion, "勤務割表表示切替確認") Select Case ret Case vbOK UserForm8.Show vbModeless UserForm8.Repaint 当月データのクリア メインデータの復元5月 編集データの復元5月 Sheets("メイン・1").Select Unload UserForm8 図形の貼付け Case vbOKCancel Exit Sub End Select End If End Select End Select Next End Sub

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • WorkSheet_Changeを2つ反映させる

     下記のコードをWorkSheetで2つ反映させるにはどうしたらいいでしょうか?どちらか一つなら反映するのはわかりますが、どう名前を変更すればいいのかお教え願えませんでしょうか? windows7・SP1 Office2010 Private Sub WorkSheet_Change(ByVal Target As Range) If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub '検査範囲 Application.EnableEvents = False '再帰実行の停止 If Range("C1").Value <> Sheets("祝祭日").Range("A1").Value Then MsgBox ("祝日の設定を反映するため年度を同じにしてください。") End If Application.EnableEvents = True End Sub Private Sub WorkSheet_Change(ByVal Target As Range) Dim MyRow As Long Dim MyCol As Integer MyRow = Target.Row MyCol = Target.Column With Worksheets("メイン・1").Select If MyRow = 1 And MyCol = 7 Then If Target = 4 Then 'または If Target = 1 Then メインデータの復元 '動かしたいマクロ名 End If End If End With End Sub

  • ロートルの初心者です、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 最終行に入力するマクロ

    マクロ初心者です。 シート”受注書”からシート”受注履歴”に 履歴情報を書き込むマクロを作成しています。 初心者丸出しで恥ずかしいのですが、 下記のように組んでいます。 Sub 受注情報書き込み() Dim ws01 As Worksheet Dim ws02 As Worksheet Set ws01 = Worksheets("受注書") Set ws02 = Worksheets("受注履歴") ws02.Activate ' 受注No入力 ws01.Range("C2").Copy ws02.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ' 受注日入力 ws01.Range("M2").Copy ws02.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ' 出荷日入力 Sheets("粗利報告書").Range("D3").Copy ws02.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ・ ・ ・ この場合、受注書シートが空白の場合、 受注履歴シートも空白になると思うのですが、 次回、履歴を書き込む時に空白を詰めて(最終行に) 入力してしまう事を避けたいです。 空白は残しつつ、一受注を同じ列に入力する為には、 どうしたら良いでしょうか?

  • 既存のマクロを他のエクセルファイルで使用したい

    下記のマクロを使おうと思うと、 このマクロがついたファイルを開いて 他のエクセルファイルを開くのですが使えません。 使おうとするとマクロのついたファイルに戻ってしまいます。 Sub test01() Dim ws As Worksheet For Each ws In Worksheets If ws.Name = "統合シート" Then Else ws.Activate d = ws.Range("A65535").End(xlUp).Row ws.Range(Cells(1, "A"), Cells(d, "C")).Copy Sheets("統合シート").Activate Sheets("統合シート").Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If Next End Sub どこを変えればよいのでしょうか。 教えてください。 よろしくお願いします。

  • EXCLの自動マクロ記録を簡潔に編集をお願いします。

    すみません教えてください。  収支会計.XLSの売上台帳のシートを別ファイル確定申告2.xlsの売上作業範囲シートに貼り付けたく自動マクロを記録したのですが、いまいち動きがぎこちなく重く何とかスムーズに出来ないでしょうか? Sub 売り上げ書き込み() ' ' 売り上げ書き込み Macro ' Range("A2:F251").Select Selection.Delete Shift:=xlUp Application.Left = 20.8 Application.Top = 34 Windows("収支会計.XLS").Activate With ActiveWindow .Top = 3.4 .Left = 9.4 End With Sheets("売上台帳").Select ActiveWindow.SmallScroll Down:=-55 ActiveWindow.ScrollRow = 1 With ActiveWindow .Top = 87.4 .Left = 37 End With Range("D5:H1004").Select Selection.Copy Windows("確定申告2.xls").Activate Range("B2").Select ActiveSheet.Paste Range("A2").Select Windows("収支会計.XLS").Activate Range("C5:C430").Select Application.CutCopyMode = False Selection.Copy Windows("確定申告2.xls").Activate ActiveSheet.Paste Range("H8").Select End Sub 宜しくお願いします。

専門家に質問してみよう