• ベストアンサー
  • すぐに回答を!

エクセルVBAなぜ実行時エラーが?

エクセル2000です。 DATAと名づけた表の値を変換し、最大値から端数をプラマイするマクロなのですが、途中で「実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません。」となってしまいます。 なぜ出るかわからないので別なBookに同じ名前のRange をつくり同様の表でためしたらエラーにならずちゃんと作動します。 本番用のBookでのみエラーがでます。なぜなのでしょうか? 実行時エラーのでる With Range("DATA").Find(mx, LookIn:=xlValues) .Value = .Value + dff ' End With を、Withブロックをつかわず Range("DATA").Find(mx, LookIn:=xlValues).Select で試しても本番のBookではエラーになります。ほんとに困っています。 Sub 調整() Dim r As Double Dim c As Range Dim dff As Integer, mx As Long r = 25000 / Range("初期").Value With Sheets("内訳") Range("DATA").Value = .Range("F57:L73").Value '初期値複写 'MsgBox "初期値転写完了" For Each c In Range("DATA") If c.Value <> "" Then c.Value = Application.WorksheetFunction.Round(c.Value * r, -1) End If Next 'MsgBox "初期変換完了" dff = 25000 - Range("変換後") If dff <> 0 Then 'MsgBox dff mx = Application.WorksheetFunction.Max(Range("DATA")) 'MsgBox mx With Range("DATA").Find(mx, LookIn:=xlValues) .Value = .Value + dff 'ここで実行時エラー! End With End If End With End Sub

共感・応援の気持ちを伝えよう!

  • 回答数7
  • 閲覧数1679
  • ありがとう数7

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

  • ベストアンサー
  • 回答No.5
  • Wendy02
  • ベストアンサー率57% (3570/6232)

こんにちは。 Wendy02です。 いずれにしても、Find 自体が問題が発生しているとなると、一度、ワークシートのメニューから、検索を試してみることですね。 必ずしも、これが通っても、マクロで通るとは限りません。例としては、検索値を手で入れた場合ではうまくいくけれども、変数で入れた場合や、また、ワークシートの書式の違いによって、検索できないことがあります。Findは、その点がひじょうにややこしくて、一般の数字は問題ない「はず」ですが、いくつかトライアルをしてみるしかありません。 何か別のトラブルが含まれていて、それが表に出てきているかもしれません。 Find メソッドで行っているときと、実際の検索のシート・オブジェクトなどに整合性がなくなっている可能性もあります。それから、こういう場合に、私は、全体で試さずに、一部のコードを取り出して、スモールサンプルで、検査します。 例: LookAt:=xlWhole → xlPart にしたら? LookIn:=xlValues → xlFormulas にしたら? Sub Test() Dim mx As Long dff = 10 mx = Application.WorksheetFunction.Max(Range("DATA"))  'Worksheets("内訳").Activate  With Worksheets("内訳").Range("F100:L116").Find(What:=mx, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)  '.Select  .Value = .Value + dff  'ここで実行時エラー! End With End Sub 念のため、標準モジュールに書いていますよね。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

なんと、驚いたことに、手動でメニューの「編集」、「検索」でやってみても、範囲内から数値を検索することが出来ませんでした!最大、最少にかかわらず、表内の数値はどれも検索できないのです。 ワークシート関数で=MAX(範囲)ではちゃんと出るのですが・・・。 これはどういうことなのでしょう?

関連するQ&A

  • エクセルのVBAで悩んでいます。

    いつもありがとうございます。 エクセルのVBAで悩んでいます。 セルの範囲指定をVBAで行いたいのです。 ただし、引数に数値変数を使用する為、Cellsプロパティを使います。 すると、離れている範囲の範囲指定が出来ないのです。 例えば、Rangeプロパティだと、 Range("A5:E5,A9:E32").Select こうなるところを、 A9:E32 を変数に置き換えたくて、 Range("A5:E5", Cells(g, 1), Cells(h, 5)).Select と、するとエラーが出ます。 VBAの前文は次の通りです。 Private Sub CommandButton1_Click() a = Me.TextBox1.Value b = Me.TextBox2.Value Set c = Range("a:a").Find(what:=a, LookIn:=xlValues, lookat:=xlWhole) Set d = Range("a:a").Find(what:=b, LookIn:=xlValues, lookat:=xlWhole) 'MsgBox c + d e = c.Address 'MsgBox e f = d.Address 'MsgBox f g = Range(e).Row MsgBox g h = Range(f).Row MsgBox h Range(Cells(g, 1), Cells(h, 5)).Select End sub よろしくお願い致します。

  • EXCEL VBA エラーの意味が分からず

    いつも、お世話になっております。 下記コードで、レコード1と2を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。 どうかご教授いただけないでしょうか。よろしくお願いいたします。 エラーの状況 inputシートで、maeとtsugiの動作を何度か行うと、「If pict.TopLeftCell.Address = targetRange.Address Then」の部分が黄色く塗りつぶされ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されてしまします。たぶん写真の削除の時にエラーになっているのだと思いますが、 '■標準モジュールのコード。dataシートのレコードを移動し、inputシートのBC1セルに表示する。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() On Error GoTo errhandle If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If Exit Sub errhandle: Call Saisyo End Sub Sub Tsugi() On Error GoTo errhandle If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If Exit Sub errhandle: Call Saigo End Sub Sub Tenki() Worksheets("input").Range("BC1").Value = trg.Offset(0, 0) End Sub '■sheet 1のモジュール。inputシートBC1セルの値を見て、dataシートへ値を読みにいき、inputシートへ表示する。 Private Sub hyouji() Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If kensaku = fRange.row '検索された顧客DCの行位置を求める Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value '整理No Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value '固有ID Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value '工場名 Range("P4").Value = Sheets("data").Cells(kensaku, 4).Value '柱No Range("W4").Value = Sheets("data").Cells(kensaku, 5).Value '盤No Range("I5").Value = Sheets("data").Cells(kensaku, 6).Value '変台系統1 Range("S5").Value = Sheets("data").Cells(kensaku, 7).Value '変台系統2 Range("I6").Value = Sheets("data").Cells(kensaku, 8).Value '分電盤設置時期 Range("B8").Value = Sheets("data").Cells(kensaku, 9).Value '主な供給先 Range("B14").Value = Sheets("data").Cells(kensaku, 10).Value '特記 Range("AD4").Value = Sheets("data").Cells(kensaku, 11).Value '盤位置の目安 Range("AT8").Value = Sheets("data").Cells(kensaku, 12).Value '幹線線相 Range("R36").Value = Sheets("data").Cells(kensaku, 13).Value '盤写真ファイル名 Range("AT36").Value = Sheets("data").Cells(kensaku, 14).Value '単結図ファイル名 End Sub '■sheet 1のモジュール。"$R$36"と"$AT$36"の写真ファイル名を見て、"C37"と"AE37"セルに表示させる。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim touroku As Long Select Case Target.Address Case "$BC$1" Call hyouji Case "$R$36" myLoadPicture "board_Image", Target.Text, Range("C37") Case "$AT$36" myLoadPicture "map_Image", Target.Text, Range("AE37") Case "$AT$8" Call red_circle Case Else Exit Sub End Select End Sub Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range) Dim pict As Shape, picPath As String picPath = ThisWorkbook.Path & "\" & folderName & "\" & fname If fname = "" Then picPath = ThisWorkbook.Path & "\" & folderName & "\" & "NoImage.jpg" End If With ActiveSheet For Each pict In .Shapes If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete Exit For End If Next pict Set pict = .Shapes.AddPicture(picPath, msoTrue, msoFalse, _ targetRange.Left, targetRange.Top, 300, 360) End With End Sub

  • Excel VBAデータ登録のスピードアップしたい

    下記のようなコードがあります。 ■input データ閲覧・登録・編集シート ■data データを格納するシート inputシートとdataシートでdataの受け渡しを行っているのですが、データレコードを切り替えるだけで20秒ちょっとかかるため、作業効率が悪いです。 この時間を1&#65374;2秒ぐらいまで減らすには、どのように修正すれば、いいでしょうか?どうかアドバイスをお願いいたします。 Private Sub datatouroku() ’データを登録する Dim touroku As Integer Dim fRange As Range Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) touroku = fRange.Row '検索されたNoの行位置を求める Sheets("data").Cells(touroku, 1).Value = Range("BC1:BE1").Value Sheets("data").Cells(touroku, 2).Value = Range("AX1").Value Sheets("data").Cells(touroku, 3).Value = Range("I4").Value   '・・・上記のデータが全部で256件あります。 End Sub &#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293; Private Sub hyouji() 'データを表示させる Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)    If (fRange Is Nothing) Then '見つからなかった?    MsgBox "入力された顧客コードが存在しません。", vbExclamation    Exit Sub    End If    kensaku = fRange.Row '検索された顧客DCの行位置を求める     Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value     Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value    Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value     '・・・上記のデータが全部で256件あります。 Set trg = Sheets("data").Cells(kensaku, 1) End Sub

その他の回答 (6)

  • 回答No.7
  • Wendy02
  • ベストアンサー率57% (3570/6232)

merlionXX さん、Wendy02です。 とりあえず、解決してよかったです。 私は、たぶん、今日のことは、深く記憶に留めておくことにします。時間・日にちの検索は、マクロではうまくできないのは知っていたので、おもに、Match 関数を使っていましたが、「会計」もそうだったのですか。なんとなく、「書式」が関係していることがあるのは知っていたのですが、難しいですね。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございました。 わたしも今日は印象に残る一日でした。 Wendy02さんのアドバイスがなかったら土日もなくなっていたところです。 有難うございました。

  • 回答No.6
  • Wendy02
  • ベストアンサー率57% (3570/6232)

追伸です。 LookAt:=xlWholeは、そのままで、 Dim mx As Long   ↓ Dim mx As Double にしてみたら、いかがですか?

共感・感謝の気持ちを伝えよう!

質問者からのお礼

なんどもなんどもありがとうございます。 問題はマクロではなくシートだったようです。 表の書式を「会計」から「標準」に変えたところ、無事作動しました。 テスト用はもちうろん「標準」でした。本番用が「会計」だったのが原因のようです。とほほ。

  • 回答No.4
  • Wendy02
  • ベストアンサー率57% (3570/6232)

merlionXX さん、こんにちは。 実際には、最初のご質問のコードでは、読み取れないのですが、もしかして、それは、Findを使うシートはActiveではないのではありませんか?(^^; 明示的に、シート名を入れても、シートを Activate しないと、Findが通らないときがあります。それは、一種のバグのようなものだと思います。(違うかもしれませんが) まだ、新しいコードは、別のブックで、Find が、最後まで一度も通っていませんね。 たぶん、一度、Find が通れば、Activeでなくても通るようなのですが、そういう偶然性(?)があるようなのです。 たぶん、Find の前に、検索させるシートを.Activeとか. Select とかすればよいのですが……。 ちょっとコードとして、格好が悪いですね。そういうようですと、Find 自体が失敗かもしれないなって思っています。一般論なのですが、Excelのワークシート上のコマンドを使用する時、その状況に左右されることがあり、必ずしもマクロではうまくいかないものがいくつかある、ということです。(私の配慮が足らなかったようで、申し訳ないです! )

共感・感謝の気持ちを伝えよう!

質問者からのお礼

何度も何度もすみません、恐縮です。 わたしもテストではうまくいき、本番でだめ、別ファイルに転記した同一コードはうまくいき、再度本番がだめで、パニクってます。 アクティブじゃないせいかとも思い、本番シートをアクティブにして試してもみましたが同じなんです。参りました。

  • 回答No.3
  • Wendy02
  • ベストアンサー率57% (3570/6232)

merlionXX さん、こんにちは。 Wendy02です。 後、私も良く失敗する例としては、Find の引数の省略による失敗です。 今回も、私は省略してしまいましたが、Find は、前回使った設定を残していることがあって、時々失敗しますので、私の VB Editor には、Find のテンプレートをいれています。そうしないと、つい忘れてしまいます。 With Find ( _ What := mx , _ LookIn := xlValues , _ LookAt := xlWhole , _ SearchOrder:= xlByColumns , _ SearchDirection:= xlNext) これは、一行にしてしまってよいです。通常、AfterとMatchCase MAtchByte は抜いてよいですが、人によっては、引数の名称を用いず、引数を全て入れる代わりに「,」だけで数字のみだけで済ませてしまう人もいます。ただ、それは、コツがあるようで、組み込み定数ではないようなので、私は詳しくありません。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

何度もお手数をおかけします。 With .Range("F100:L116").Find(What:=mx, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext) .Value = .Value + dff End With としてみましたが、やはり同じ.Value = .Value + dff でエラーになってしまいます。

  • 回答No.2
  • Wendy02
  • ベストアンサー率57% (3570/6232)

こんにちは。Wendy02です。 かなり、余談が含まれていますが、ご勘弁ください。 mx = Application.WorksheetFunction.Max(Range("DATA")) Find の手前の値から見てみるとよいです。 領域に数値がある限りは、論理的に、エラーにはなるはずがありません。しかし、エラーになるというのは、mx 値が取れていないからです。 見つからない場合でも、必ず、値 0 が入りますね。mx 値は、Long型ですから、避けようがありません。それで、Find で探せば、見つからないので、エラーになりますね。 そこで、もう1つ気になっているのは、前回見て気が付いたのは、Range("DATA")ということです。 VBAでは、通常、そのような書き方はしません。その理由は、変えられてもコードからでは気が付かない、ということです。暗黙的な領域だということですね。もう1つは、名前定義というのは、VBA側からだと、意外に使いにくいという面があります。名前定義を使う場合は、VBAの場合、その都度削除しなければならない時があるくらいです。 ですから、最初から、領域のキメウチが出来ないときは、Range("A1").CurrentRegion などで、領域を確保するか、Application.InputBox で、対話型入力するか、どちらかだということになりますね。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

いつもありがとうございます。 mx = Application.WorksheetFunction.Max(Range("DATA")) MsgBox mx でmxの値がちゃんと返るのでmx 値が取れているのではないでしょうか? ご指摘のRange("DATA")をすべて、Range("F100:L116")に変えてみましたが同様でした。(泣)

  • 回答No.1
  • ja7awu
  • ベストアンサー率62% (292/464)

まぁ、一番考えられることは、Findで見つかっていないことでしょうね。 エラーが出るデータで、 .Value = .Value + dff  の行にブレークポイントを設定し、 コードを実行し、イミディエイトウィンドウに ? Range("DATA").Find(mx, LookIn:=xlValues).Address <Enter> や、 ? Range("DATA").Find(mx, LookIn:=xlValues) Is Nothing <Enter> で何と返りますか?

共感・感謝の気持ちを伝えよう!

質問者からのお礼

早速ありがとうございます。 大変申し訳ありませんが、イミディエイトウィンドウの使い方がわかりません。 .Value = .Value + dff  の行にブレークポイントを設定するにはクリックして茶色い●を出せばいいのですよね? ? Range("DATA").Find(mx, LookIn:=xlValues).Address <Enter> は ? Range("DATA").Find(mx, LookIn:=xlValues).Addressをコピペしてエンターキーですか? そうやったら実行時エラーの同じメッセージがでましたが・・・。(泣)

質問者からの補足

今、Value = .Value + dff の行にブレークポイントを設定し、コードを実行し、イミディエイトウィンドウに ? Range("DATA").Find(mx, LookIn:=xlValues) Is Nothing とコピペしてエンターキーしたら Trueと返りました。 xlValuesのところにカーソルがふれたらxlValues=-4163と表示されました。???

関連するQ&A

  • Visual Basic Editorの実行時エラーのことについて教えてください。 

    Visual Basic超初心者ですがよろしくお願いします。 標準モジュールで入力したものを実行すると、必ず「実行時エラー "53": ファイルが見つかりません。」と表示してしまいます。 入力したものはミスはないと思うのですが、何回やってもエラーが出てしまいます。 わかる方いましたら教えてください。 入力したものを一応載せときます↓ Sub list_file() Dim numfile As Long Dim i As Long With Application.FileSearch .NewSearch .LookIn = Range("b1").Value .Filename = Range("b2").Value .SearchSubFolders = Range("b3").Value If .Execute() > 0 Then file_count = .FoundFiles.Count MsgBox file_count & "files exis" Worksheets.Add after:=Worksheets("sheet1") Range("a1").Value = "filename" Range("b1").Value = "date" Range("c1").Value = "size" For i = 1 To file_count Cells(i + 1, 1).Value = .FoundFiles(i) Cells(i + 1, 2).Value = FileDateTime(.FoundFiles(i)) Cells(i + 1, 3).Value = FileLen(.FoundFiles(i)) Cells(i + 1, 2).Value = Hex(Cells(i + 1, 3).Value) Next Columns("a:c").AutoFit Else MsgBox "no file exists" End If End With End Sub

  • VBA  エラー

    Sub 上下カット1() Dim MyR As Range, MyMax As Integer, MyMin As Integer Dim MX As Range, MN As Range With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D15:P15")) MyMin = WorksheetFunction.Min(.Range("D15:P15")) For Each MyR In .Range("D15:P15") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D16:P16")) MyMin = WorksheetFunction.Min(.Range("D16:P16")) For Each MyR In .Range("D16:P16") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With End Sub を実行すると、 MX.Borders(xlDiagonalUp).LineStyle = xlContinuous の部分にエラーがでます。 対処方法を教えてください。

  • VBA エラー

    Sub 上下カット1() Dim MyR As Range, MyMax As Integer, MyMin As Integer Dim MX As Range, MN As Range With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D15:P15")) MyMin = WorksheetFunction.Min(.Range("D15:P15")) For Each MyR In .Range("D15:P15") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D16:P16")) MyMin = WorksheetFunction.Min(.Range("D16:P16")) For Each MyR In .Range("D16:P16") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With End Sub を実行すると”オブジェクト変数またはWithブロック変数が設定されていません。”と出ます。 どうしたらいいですか?

  • エクセルマクロ実行時エラー1004について

    システムを起動すると実行時エラー1004とでて5行目のWorksheets(3).Selectで止まってしまいます。 私が作成したものではなく、なぜなのかわかりません。緊急を要しています。誰かわかる方いらっしゃらないでしょうか。 よろしくお願いします。 Dim Max_data2 As Integer Public Cunt_01 As Integer Sub auto_open() Dim wkSheet As Excel.Worksheet Worksheets(3).Select ' Range("c4") = Date ' Range("c20") = Date Range("d6").Select With Worksheets("工場、受注一覧表") ' Worksheets("工場、出荷指示書").Range("j3").Value = Date ' Worksheets("工場、出荷指示書").Range("I4").Value = Date ' Worksheets("工場、出荷指示書").Range("J4").Value = Time .Range("d5").Value = Date .Range("d21").Value = Date .Range("d23").Value = Date End With For Each wkSheet In ThisWorkbook.Worksheets If InStr(wkSheet.Name, "工場、出荷指示書") <> 0 Or InStr(wkSheet.Name, "@") <> 0 Then wkSheet.Range("J3").Value = Date wkSheet.Range("I4").Value = Date wkSheet.Range("J4").Value = Time End If Next Call com_list Cunt_01 = 10 '1件づつ転記のカウンタ '★追加★ '入出庫報告書のファイルを開く Dim sPath As String sPath = ThisWorkbook.Worksheets("工場、受注一覧表").Range("W1").Value If sPath = "" Then Exit Sub End If If Dir(sPath) <> "" Then Workbooks.Open (sPath) End If ThisWorkbook.Activate ''★23.06.12 ActiveWindow.SmallScroll ToRight:=4 End Sub

  • excel vba のエラー原因が分かりません

    データ入力シート「Hit Data] データ表示シート「User Sheet」 とあります。 データ表示シート「User Sheet」に「次へ」「前へ」「最初へ」「最後へ」とボタンをつくり、データ入力シート「Hit Data]から、都度データを呼び出せるようにするプログラムをとあるサイトを参考にして作成しましたが、エラーが出てしまいどうしてもうまくいきません。 どこに問題があるのか見ていただけないでしょうか? '以下標準モジュールのプログラムです Public trg As Range Sub Saisyo()  Set trg = Worksheets("Hit Data").Range("A3")  Call Tenki End Sub Sub Saigo()  Set trg = Worksheets("Hit Data").Range("A60000").End(xlUp)  Call Tenki End Sub Sub Mae()  If trg.Row >= 4 Then   Set trg = trg.Offset(-1, 0)   Call Tenki  Else   MsgBox "これより前のレコードはありません"  End If End Sub Sub Tsugi()  If trg.Row < Worksheets("Hit Data").Range("A60000").End(xlUp).Row Then   Set trg = trg.Offset(1, 0)   Call Tenki  Else   MsgBox "これより後ろのレコードはありません"  End If End Sub Sub Tenki()  Worksheets("User Sheet").Range("D9").Value = trg.Offset(0, 0)  Worksheets("User Sheet").Range("D10").Value = trg.Offset(0, 1)  Worksheets("User Sheet").Range("D11").Value = trg.Offset(0, 2)  Worksheets("User Sheet").Range("D12").Value = trg.Offset(0, 3) End Sub '以下 User Sheet"のシートモジュールに記載されたプログラムです。 Private Sub Worksheet_Activate() Call Saisyo End Sub '表示されるエラーの内容 'saisyo・・・アプリケーション定義またはオブジェクト定義のエラーです。 'saigo・・・同上 'mae・・・オブジェクト変数またはWithブロック変数が設定されていません 'tugi・・・同上

  • エクセルVBAのFINDの質問です。

    エクセルVBAのFINDの質問です。 シート1    A    B    C     D 1 コード1 コード2 コード3 名 称 2  4    1     1 3  4    2     2 4  4    3     1 シート2    A    B 1 コード1 名 称 2  1   名称1 3  2   名称2 やりたいことは、シート1のD列に、シート1のコード3をもとにシート2から名称を取得したいのです。 下記に記したプログラムだと最初のFINDNEXTは動くのですが、 2回目でエラーになってしまい、次を読んでくれません。 どなたか、ご教授頂けますでしょうか。 シート1の検索条件はコード1の"4"です。 シート1のコード1は重複キーで、一レコードずつ読んで行き、各レコード毎にシート2を読みたい のです。 Dim シート1 As Worksheet Dim シート2 As Worksheet Dim obj As Object Dim Lin As Integer Dim mykey As Integer Dim obj1 As Object Dim Lin1 As Integer Dim mykey1 As Integer Dim st_Lin As Integer Set シート1 = ThisWorkbook.Worksheets("シート1") Lin = シート1.Cells(シート1.Rows.Count, 1).End(xlUp).Row mykey = "4" Set obj = シート1.Range("A1", "A" & Lin).Cells.Find(What:=mykey, _ LookIn:=xlValues, _ lookat:=xlWhole, _ SearchOrder:=xlByColumns) If obj Is Nothing Then   MsgBox ("異常です")   Exit Sub Else   st_Lin = obj.Row   Do Until obj.Row <> st_Lin    Set obj = シート1.Range("A1", "A" & Lin).FindNext(obj)    If obj Is Nothing Then     Exit Do    Else     Set シート2 = ThisWorkbook.Worksheets("シート2")       With シート2          Lin1 = .Cells(シート2.Rows.Count, 1).End(xlUp).Row          mykey1 = シート1.Cells(obj.Row, 3).Value          Set obj1 = .Range("A1", "A" & Lin1).Cells.Find          (What:=mykey1,LookIn:=xlValues,lookat:=xlWhole,SearchOrder:=xlByColumns)          If obj1 Is Nothing Then           MsgBox ("名称取得できませんでした")           Exit Sub          Else            シート1.Cells(obj.Row, 4).Value = .Cells(obj1.Row, 2).Value          End If       End With    End If   Loop End If

  • エクセル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

  • VBA のエラーがわかりません・・・w

    Sub Worksheet_Change(ByVal Target As Range) Dim 初期値 As Integer Dim 増減値 As Integer Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("D6").Value = 0 Range("E5").Value = 400 Range("E6").Value = 0 Range("B7").Value = "★1 MaxAttackPoint:700 / MaxDeffencePoint:900" Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("D6").Value = 0 Range("E5").Value = 500 Range("E6").Value = 0 Range("B7").Value = "★2 MaxAttackPoint:1100 / MaxDeffencePoint:1300" End Select Case "$D$5" Select Case Range("C5").Value Case 1 初期値 = 600 Case 2 初期値 = 1000 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("D6").Value = (初期値 - Target.Value) / 100 * 増減値 Case "$E$5" Select Case Range("C5").Value Case 1 初期値 = 400 Case 2 初期値 = 500 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("E6").Value = (初期値 - Target.Value) / 200 * 増減値 End Select End Sub Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$F$5" Select Case Target.Value Case "炎" Range("F6").Value = 4 Case "水" Range("F6").Value = 4 End Select   Case "$G$5" Select Case Target.Value Case "ドラゴン" Range("G6").Value = -8 Case "海竜" Range("G6").Value = -8 End Select Case "$H$5" Select Case Target.Value Case "ドラゴン" Range("H6").Value = -16 Case "海竜" Range("H6").Value = -16 End Select Case "$I$5" Select Case Target.Value Case "○" Range("I6").Value = 40 Case "×" Range("I6").Value = 0 End Select End Select End Sub とあるカードゲームのステータス決定を行う為に組まれたマクロです。 作成者は私だけではないのですが、もう何回もしつこく質問をしているため 気が引けてしまい、こちらで質問することにしました・・・w   エラー内容は 2つ目のSub Worksheet_Change(ByVal Target As Range)の 「Worksheet_Change」の名称が間違っています。 という事でした。何を入れればいいのかサッパリです(;´ω)   エラーの改善方法について教えてください。 宜しくお願いします

  • excel match で日付が見つからない

    ■困っていること vbaの worksheetfunction のmatach関数を用いているが、日付が見つかってくれない。 なぜ見つからないか、原因を教えていただけないでしょうか?よろしくお願いします。 ■状況、やりたいこと 下記、コードで、「fRow」と「syu」までは正しく求められるのですが、「tcol」を求めようとすると、どうしても0になってしまいます。 ワークシートはD1セルに日付を入力おり、さらに右のセルへ行く毎に+7しています。「syu」の日付がどの週に該当するのかを、列数で求めたいです。 例えば、10年3月17日なら、Fの列なので 6 を求められるようにしたいです。 sub test() Dim fRow As Long Dim tcol As Long Dim syu As long With Worksheets("data") Set fRange = Sheets("data").Columns(1).Find(What:=TextBox1.Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then Exit Sub End If fRow = fRange.Row   syu = .Cells(fRow, 2).Value tcol = Application.WorksheetFunction.Match(syu, .Range("1:1"), 1) msgbox tcol   end with end sub

  • エクセル VBA

    Dim h As Range If Application.CountIf(Range("p:p"), 5) = 0 Then Exit Sub Set h = Range("p:p").Find(what:=5, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious) Range(Range("p2"), h).EntireRow.Delete Shift:=xlShiftUp 上記のマクロは、「2行目から、P列の数値が5の最下の行までを削除する」という内容です。 この5の部分を、<0(0未満)に変えたいのですがわかりません。 どうぞ教えてください。