• ベストアンサー

エクセルVBA　selectionの書き方をヘルプ！

ここで教えてもらったVBAを書き直して以下のように作りました。 Sub TEST() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") d = 5 For i = 1 To d Set x = sh2.Range("E7:F11").Find(What:=sh1.Cells(i, "C"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not x Is Nothing Then sh1.Cells(i, "D") = x.Offset(0, 1) Next i End Sub ところが「RangeクラスのFindプロパティが取得できません」とエラーになってしまいます。Range("E7:F11")をCellsにすればエラーにはならないのですが、検索範囲を指定したいのです。 sh2.Select Range("E7:F11").Select　を入れ、Range("E7:F11")をSelectionにすれば動くのもわかりました。でもSelectせずにやりたいのです。 わがまま言いますが、お教えくださいませ。 お願いします。

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

  • ベストアンサー
noname#29107
noname#29107
回答No.8

＃１です。 ＃７を訂正します。 「＃２さんが、触れられているように、Sheet2のE7～F11の間を選択していれば、正常に終了するはずです。」を 「＃２さんが、触れられているように、アクティブなワークシートのE7～F11の間を選択していれば、正常に終了するはずです。」に訂正します。 また「この場合、Rangeで指定したSheet2のE7～F11以外にActivecellがあるとAfter指定が解釈できなくなりますので、エラーになったものでしょう。」を 「この場合、Rangeで指定したE7～F11以外にActivecellがあるとAfter指定が解釈できなくなりますので、エラーになったものでしょう。」に訂正します。 今回の場合、E7～F11が選択されているのは、Sheet2である必要はありませんでした。 あと＃５さんの仰るようなActivecellが失敗するのは、グラフシートなどワークシートが以外がアクティブだった時になります。

error123
質問者

お礼

はい、納得しました。 なんどもありがとうございました。

その他の回答 (8)

  • popesyu
  • ベストアンサー率36% (1782/4883)
回答No.9

あーそうですねぇ。 どこのシートでも良いから、そのRange範囲内のセルがアクティブだったらそれで通りますねぇ。 After引数が他のシート上のActiveCellでもとりあえずAddressだけその範囲内のが返ってくればそれで通るみたいです。 Afterを指定するならRange("E7")とでもしておくのが良いかと思います。 これはE7から検索を開始するという意味です。 指定しなくてもE7（Range範囲内の一番左上）からになります。

error123
質問者

お礼

なんどもありがとうございました。

noname#29107
noname#29107
回答No.7

＃１です。 ＞でもなぜなんでしょうか？ ＃２さんが、触れられているように、Sheet2のE7～F11の間を選択していれば、正常に終了するはずです。 afterパラメータは、特定のセル以降のセルを検索の対象範囲にするという指定ですが、この場合、Rangeで指定したSheet2のE7～F11以外にActivecellがあるとAfter指定が解釈できなくなりますので、エラーになったものでしょう。 今回の場合、＃５（と＃６）さんの回答は誤解されていると思います。

  • popesyu
  • ベストアンサー率36% (1782/4883)
回答No.6

修正です。 「ヘルプにもありますがアクティブなシートでないシートのActiveCell プロパティは失敗します。」です。 ちなみに対応については Afterは別に指定する必要もそうそうないので削っておけば問題ないかと思います。 どうしても指定したいならActiveCell以外の方式で指定しましょう。

error123
質問者

お礼

なんどもありがとうございました。

  • popesyu
  • ベストアンサー率36% (1782/4883)
回答No.5

ヘルプにもありますがアクティブなシートでのActiveCell プロパティは失敗します。 これはエクセルの仕様です。 分かり易い例で示すと Dim WS1 As Worksheet Dim WS2 As Worksheet Set WS1 = Worksheets(1) Set WS2 = Worksheets(2) WS2.Activate 'WS1.Activate '↑ここのコメントを外すとエラーになります。 WS2.Range(ActiveCell.Address).Activate ※ActiveとSelectは微妙に意味合いが違いますが、ここでの使われ方はほぼ同じ意味です。

error123
質問者

お礼

ありがとうございました。

  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.4

#3です。 他の人と同じように After:=Activecellを削除して やってみたらsh3.selectも要りませんでした。

error123
質問者

お礼

なんどもありがとうございます。

  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.3

Range("E7:F11").selectはいらないけど sh2.Selectは、要ると思う。

error123
質問者

お礼

やってみましたがダメでした。 After:=ActiveCellを取ったらOKとなりました。

  • bec
  • ベストアンサー率29% (151/507)
回答No.2

Findメソッドの、After:=Activecellが不要かなと思います。 sheet2のE7～F11を選択してれば問題なく動きますが、 そうでない場合は、検索範囲外になってしまいます。 こちらの環境（Excel2002）では問題なく動きました。 何かしらの条件で、このメソッドが必要だったら無視してください。

error123
質問者

お礼

ありがとうございます。 After:=ActiveCellを取ったらエラーになりませんでした。 でもなぜなんでしょうか？

noname#29107
noname#29107
回答No.1

私の環境では（Excel2003）「型が一致しません」というエラーになるので、自信はありません。 Set xのところのAfter:=ActiveCellを取ってみたらどうでしょう？ Set x = sh2.Range("E7:F11").Find(What:=sh1.Cells(i, "C"), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

error123
質問者

お礼

ありがとうございます。 After:=ActiveCellを取ったらエラーになりませんでした。 でもなぜなんでしょうか？

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • エクセルＶＢＡで実行時エラー　91　が出ます

    エクセル2000です 各部署の棚卸を纏める為のＶＢＡを作成しているのですが、実行時にエラーになってしまいます エラーメッセージは 「実行時エラー　91 　　オブジェクト変数またはＷｉｔｈブロック変数が設定されていません」 です ご教授お願いいたします 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

  • Excel　VBA元データから別シートへ振り分け

    元データ（DB)をA列の値で振り分け 別シート（印刷）に転記していく方法について教えてください。 以下のコードで転記は行えましたが１つの値で１つのシートを作成になってしまいます。 どこをどのように変更すればA列の値（一種類に１つのシートにまとめたい）に １つのシートに転記となるかご教示お願いします。 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 よろしくお願いいたします。

  • VBA　初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim　 i 　as 　integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub

  • エクセルVBAについて

    前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 Sub TESTa() Dim A As Long Dim B As Long Dim C As Long Dim D As Long Dim E As Long Dim F As Long '表の行数を調べる A = Worksheets("sheet1").Range("C65536").End(xlUp).Row - 1 For C = 1 To A For B = 4 To 7 'Sheet1のデータをSheet2に複写する Worksheets("Sheet2").Cells(B - 3 + D, 15) = Worksheets("Sheet1").Cells(C + 1, 1) Worksheets("Sheet2").Cells(B - 3 + D, 6) = Worksheets("Sheet1").Cells(C + 1, B) Worksheets("Sheet2").Cells(B - 3 + D, 14) = Worksheets("Sheet1").Cells(C + 1, 3) Worksheets("Sheet2").Cells(B - 3 + D, 10) = Worksheets("Sheet1").Cells(1, B) Worksheets("Sheet2").Cells(B - 3 + D, 13) = Worksheets("Sheet1").Cells(C + 1, 2) Next D = C * 4 Next 'Sheet2の表の行数を調べる Sheets("Sheet2").Select E = Worksheets("sheet2").Range("F65536").End(xlUp).Row '0欄の確認 For F = E To 1 Step -1 If Worksheets("Sheet2").Cells(F, 6) = 0 Then '0の場合は行を削除する Cells(F, 1).EntireRow.Delete End If Next End Sub カウントするとデータ個数がSheet1で約１２０件になりSheet2においては、４倍になりますので約４８０件になります。 そこで　Sheet1において１２件ごとに、Sheet2,3,4...としたいのです。 Sh1 NO.1～12がSheet2 Sh1 NO.13～24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか？ お手数ですがよろしくお願いいたします。

  • エクセル 何故かシート間の値のコピーが出来ない

    いつもお世話になります。 開いているブックのシート「リスト1～3」に、Book1.xlsの「リスト1～3」の値をコピーする為に、下記のマクロを作成しました。 Dim SH1, SH2, SH3, SH4, SH5, SH6 As Worksheet Set SH1 = ThisWorkbook.Worksheets("リスト1") Set SH2 = ThisWorkbook.Worksheets("リスト2") Set SH3 = ThisWorkbook.Worksheets("リスト3") Set SH4 = Workbooks("Book1.xls").Worksheets("リスト1") Set SH5 = Workbooks("Book1.xls").Worksheets("リスト2") Set SH6 = Workbooks("Book1.xls").Worksheets("リスト3") 'リスト1をコピーする D = SH4.Range("A1").CurrentRegion.Rows.Count E = SH4.Range("A1").CurrentRegion.Columns.Count SH1.Range(Cells(1, 1), Cells(D, E)).Value = SH4.Range("A1").CurrentRegion.Value 'リスト2をコピーする F = SH5.Range("A1").CurrentRegion.Rows.Count G = SH5.Range("A1").CurrentRegion.Columns.Count SH2.Range(Cells(1, 1), Cells(F, G)).Value = SH5.Range("A1").CurrentRegion.Value 'リスト3をコピーする H = SH6.Range("A1").CurrentRegion.Rows.Count I = SH6.Range("A1").CurrentRegion.Columns.Count SH3.Range(Cells(1, 1), Cells(H, I)).Value = SH6.Range("A1").CurrentRegion.Value 以上を実行すると、「アプリケーション定義またはオブジェクト定義のエラーです」とエラーメッセージが出てしまいます。 それぞれのシートの処理の時に、 SH1.Select SH2.Select SH3.Select を入れて、シートを選択してから実行すると問題なく動くのですが、何故このようなことが起こるのでしょう？

  • どなたかマクロ修正お願いします。

    自分なりに　作成してみましたがどうもうまくいきません。 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から持ってきてるからではないんでしょうか？

  • エクセル ＶＢＡ

    ＶＢＡ内で、そのＶＢＡの実行を制御することは可能でしょうか？ 下のようなコードを作ったのですが、 Sub 承認書作成() Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range Dim i As Long Dim nyuryoku(), chikuseki() Set ws0 = Worksheets("承認書作成") Set ws1 = Worksheets("顧客データ") Set ws2 = Worksheets("業者コード") Set ws3 = Worksheets("承認通知書") Worksheets("顧客データ").Select Range("テーブル1[[#Headers],[ＮＯ．]]").Select Selection.End(xlToRight).Select Selection.End(xlDown).Select Selection.ListObject.ListRows.Add AlwaysInsert:=False Range("B7").Select nyuryoku = Array("b5", "d5", "f5", "h5", "j5", "l5", "n5", "p5", "b6", "d6", "f6", "h6", "j6", "l6", "n6", "p6", "b4", "d4") '転記したいセルの位置 chikuseki = Array("0", "1", "5", "6", "8", "9", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "53", "54") '転記先の列のオフセット値 　Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0) 'データ蓄積セル 　For i = 0 To UBound(nyuryoku) r1.Offset(0, chikuseki(i)).Value = ws0.Range(nyuryokui)).Value '入力 Next MsgBox "入力完了" Dim lRowNum As Long '転記先となる行番号を求める lRowNum = ws1.Cells(Rows.Count, "b").End(xlUp).Row '転記 ws3.Cells(6, "d").Value = ws1.Cells(lRowNum, "j").Value ws3.Cells(17, "g").Value = ws1.Cells(lRowNum, "c").Value ws3.Cells(22, "g").Value = ws1.Cells(lRowNum, "l").Value ws3.Cells(22, "ac").Value = ws1.Cells(lRowNum, "ab").Value 　　 Set ws0 = Nothing 　 Set ws1 = Nothing End Sub ここに、 　 　　If call Macro1 then call 承認書作成 　'上のマクロです 　　 Else: Msgbox"中止" 「Macro1を実行しないと承認書作成マクロを実行できない」 という コードを組み込みたいのですが、うまくいきません。 ＶＢＡ内に同じＶＢＡを組み込むことは不可能なのでしょうか？

  • このマクロの意味を教えてください。

    このマクロの意味を教えてください。 このマクロの意味を教えてくれませんか？変な質問で申し訳ありません。というのも、先日インターネットからひろってそのままま真似して使っていたのですが、不具合が起こってしまいました。 しかし、どこからひろったのかどう検索しても見つからず、自分で不具合の原因がわからないのです。 どなたか、教えていただけないでしょうか。 このひとつひとつのマクロの意味を教えていただけたら大変助かります。 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

  • エクセル２０１０でマクロが動きません

    こんにちは。 マクロ超初心者です。 頑張ってエクセル２０１６でマクロ作成しましたが、エクセル２０１０で途中から動かず…。 何が悪いんでしょうか… ここから動きません…と書いたところから動きません(涙) Private Sub シート編集_Click() Application.ScreenUpdating = False Dim i Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim Sh4 As Worksheet Set Sh1 = Worksheets("あ") Set Sh2 = Worksheets("い") Set Sh4 = Worksheets("う") Dim dayCutoff As Date dayCutoff = Application.InputBox("年月日を入力してください", "お支払期限 年月日を入力", Format(Date, "yyyy/mm/dd")) Sh4.Range("D12").Value = DateSerial(Year(dayCutoff), Month(dayCutoff) + 2, 0) 'お支払期限 dayCutoff = Application.InputBox("年月日を入力してください", "請求書発行 日を入力", Format(Date, "yyyy/mm/dd")) Sh4.Range("AC3").Value = Format(Date, "yyyy/mm/dd") '発行日 Sh1.Cells.Clear With Sh1 'edit .Range("A2") = "番号" .Range("B2") = "会社名" .Range("C2") = "判定" .Range("D2") = "契約番号" .Range("E2") = "拠点" .Range("F2") = "税率" .Range("G2") = "月額(税抜)" .Range("H2") = "消費税" .Range("I2") = "月額(税込)" .Range("J2") = "今回" .Range("K2") = "全回" .Range("L2") = "店番" ここから動きません………… For i = 3 To Sh2.Cells(.Rows.Count, 1).End(xlUp).Row .Cells(i, 1) = Sh2.Cells(i, 2) .Cells(i, 2) = Sh2.Cells(i, 4) .Cells(i, 4) = Sh2.Cells(i, 3) .Cells(i, 5) = Sh2.Cells(i, 4) & "(" & Sh2.Cells(i, 6) & ")" .Cells(i, 6) = Sh2.Cells(i, 9) & "%課税" .Cells(i, 7) = Sh2.Cells(i, 8) .Cells(i, 8) = Sh2.Cells(i, 10) .Cells(i, 9) = Sh2.Cells(i, 11) .Cells(i, 10) = Sh2.Cells(i, 12) .Cells(i, 11) = Sh2.Cells(i, 7) .Cells(i, 12) = Sh2.Cells(i, 2) If Sh1.Cells(i, 10) > Sh1.Cells(i, 11) Then .Cells(i, 3) = "×" Else .Cells(i, 3) = "〇" End If If Sh1.Cells(i, 3) = "×" Then .Cells(i, 2) = "" End If Next i End With '空白行を削除 Dim j As Integer, myFlag As Boolean Dim c As Range With Worksheets("edit").Range("A2").CurrentRegion For j = .Rows.Count To 2 Step -1 myFlag = False For Each c In .Cells(j, 2) If c.Value <> "" Then myFlag = True Exit For End If Next If myFlag = False Then .Rows(j).Delete End If Next End With MsgBox "データの転記が終わりました" End Sub

  • エクセルのＶＢＡで悩んでいます。

    いつもありがとうございます。 エクセルのＶＢＡで悩んでいます。 セルの範囲指定をＶＢＡで行いたいのです。 ただし、引数に数値変数を使用する為、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 よろしくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する