- ベストアンサー
「変数の宣言」 が違うのでしょうか？
fumufumu_2006の回答
Set c = .Find(fWord, LookIn:=xlValues) を Set c = .Find(fWord, LookIn:=xlValues, LookAt:=xlWhole) にしてみてはどうでしょうか？
関連するQ&A
- Excelでマクロ実行後、編集→置換をクリック→問題が発生！
Windows XP Home Edition Excel 2002 下記１のマクロの実行後に必ず、 編集→置換をクリックしますと、画像の画面が出ます。 そしてExelを再起動すると、編集→置換をクリックしても問題なく使用できます。 しかし、再度、下記１のマクロを実行後、 ●編集→置換をクリック→画像の画面が出ます。 何回、行ってみても同じです。←このような事はよくあるのでしょうか？ 下記１のマクロ自体は、正常に動作します。 しかし、 次の作業で、別のマクロを実行しますと、動作はするのですが、 下記2の一部のコードの「置換」が行われなくなります。 素通りしてしまいます。非常に困ります。 しかし、この「別のマクロ」に On Error Resume Next を追記すると 動作します（コードの「置換」も行われます）。 しかし、この直後も必ず、●編集→置換をクリック→画像の画面が出ます。 下記１の「いい」マクロだけを除いて実行するマクロは問題はありません。 ですから、次の作業で、下記2の一部のコード（置換）も、 On Error Resume Next を追記しなくても正常動作してくれます。 どうも、「下記１」の「いい」に問題があるように思いますが・・・ つなぎ合わせ過ぎでしょうか・・・ 原因がはっきり解かりませんが、ただ、今までに、マクロの実行作業中にあまり、 「編集→置換をクリック」の操作はしたこはないので、発覚することがなかったのかもしれません。 ●をなんとか解決できませんでしょうか？ 参考：下記2の#DIV/0! #VALUE! は、数値以外の空白セル 、0 、文字等の為になります。 （これは直接的な原因ではないと思います） 何卒、よろしくお願い致します。 Call 下記１ Private Sub 下記１() Call いい Call うう Call ええ Call おお End Sub Private Sub いい() Dim i As Integer Dim nin As Range Windows("123.xls").Activate Sheets.Add after:=Worksheets(Worksheets.Count), Count:=1 For i = 1 To Worksheets.Count - 1 Worksheets(i).Activate With Worksheets(i) For Each nin In .Range("B4", .Range("B4").End(xlDown)) If nin.Cells.Value = 1 Then nin.Offset(0, -1).Copy Cells(2, 6) End If Next nin End With Call かか Range("A23", Range("A23").End(xlDown)).Copy _ Destination:=Worksheets(Worksheets.Count).Range("IV3").End(xlToLeft).Offset(0, 1) Next i End Sub Private Sub かか() Dim fWord As Integer, fAdd, c fWord = Cells(2, 6).Value Range("L3").Copy Range("A23") With Range("G:G") Set c = .Find(fWord, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then fAdd = c.Address Do c.Offset(0, 5).Copy Range("A65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fAdd End If Set c = Nothing End With '次に、同様にH列にも動作させる With Range("H:H") Set c = .Find(fWord, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then fAdd = c.Address Do c.Offset(0, 4).Copy Range("A65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fAdd End If Set c = Nothing End With End Sub ーーーーーーーーーーーーーーーーーーーーー '下記2 With Range(Range("A2").End(xlDown).Offset(3, 6), Range("A65536").End(xlUp).Offset(0, 25)) .Replace What:="#DIV/0!", Replacement:="0.0", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Replace What:="#VALUE!", Replacement:="0.0", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End With
- ベストアンサー
- その他MS Office製品
- このコードのチェックをお願い致します。
2種類のブックのデータを → 追加した１つのブックに貼り付けます。 下記 「'------ここからエラーになる----」 からエラーになります。 エラー番号 91 「オブジェクト変数またはWith ブロック変数が設定されていません」 以上 下記コードのチェックをお願い致します。 ------------------------------ Sub tes1() Dim fWord As String, fAdd, c, wb As Workbook fWord = "1" Set wb = Workbooks.Add(xlWBATWorksheet) Workbooks("ああ.CSV").Activate Rows("1:1").Select Selection.Insert Shift:=xlDown With Workbooks("ああ.CSV").Worksheets(1).Range("F:F") Set c = .Find(fWord, LookIn:=xlValues) If Not c Is Nothing Then fAdd = c.Address Do c.Offset(0, 2).Resize(8, 1).Copy wb.Worksheets(1).Range("B65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fAdd End If End With Application.CutCopyMode = False Call tes2 End Sub '-------------------- Sub tes2() Dim aWord As String, aAdd, c, wb As Workbook aWord = "1" Workbooks("いい.CSV").Activate With Workbooks("いい.CSV").Worksheets(1).Range("A:A") Set c = .Find(aWord, LookIn:=xlValues) If Not c Is Nothing Then aAdd = c.Address Do c.Offset(0, 23).Resize(1, 1).Copy '------ここからエラーになる------------------------ wb.Worksheets(1).Range("B65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> aAdd End If End With Application.CutCopyMode = False End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ FIND 検索方向の変更
いつも回答ありがとうございます。 FINDを使用した検索方向の変更についての質問です。以下のFINDの記述方法で、上から一発目に捉えられたキーワードではなく、下から一発目に捉えられたキーワードに変更するにはどうしたらよろしいでしょうか？それとも、FINDの記述方法を大幅に変えなければいけないのでしょうか？御指導の程宜しくお願い致します。 Sub TEST() Dim d As Integer Dim e As Integer Worksheets("一覧").Activate d = 3 e = 3 Do While Worksheets("一覧").Cells(d, 2).Value <> "" Dim c As Variant Dim R As Range Dim s As Range With Worksheets(Worksheets("一覧").Cells(d, 2).Value) Set c = .Columns("H").Find("増", , xlValues, 1) If Not c Is Nothing Then Set R = .Range(c.Offset(1, -4), .Cells(Rows.Count, "D").End(xlUp)) Set s = c.Offset(, -5) With Worksheets("編集用一覧") .Range(.Cells(e, 4), .Cells(e, 5)).ClearContents .Cells(e, 4).Value = s .Cells(e, 5).Value = Application.Sum(R) End With End If End With d = d + 1 e = e + 4 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBAについて
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。
- ベストアンサー
- Excel（エクセル）
- 処理時間がかかりすぎます
いろいろ調べながらマクロを書いたのですが時間がかかりすぎます。 どのうようにすれば時間短縮が図れるのでしょうか。 Sub sample() Dim tuki As Integer Dim bango As Integer Dim tukihi As Integer Dim c As Range For tuki = 1 To 12 For bango = 11 To 1000 For tukihi = 14 To 19 With Worksheets(Format(tuki) & "月").UsedRange.Rows(3) Set c = .Find(what:=Worksheets("年間予定表").Cells(bango, tukihi).Value, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then Worksheets("年間予定表").Range("N1") = c.Address Worksheets(Format(tuki) & "月").Range(c.Address).Offset(bango - 3, 0) = _ Worksheets("年間予定表").Cells(bango, 3).Value & _ Worksheets("年間予定表").Cells(bango, 2).Value & _ " , " _ & Worksheets("年間予定表").Cells(bango, 21).Value End If End With Next tukihi Next bango Next tuki End Sub Sub youbi_s
- 締切済み
- オフィス系ソフト
- マクロのループが次へ進みません！！
Sub 不要な行を削除() Dim fWord As String, fAdd, c, wb As Workbook fWord = "ああ" '←"ああ"の行は複数あります '下記3行はなくてもよいかも。以前、あったほうがうまく実行できましたので。 Workbooks("てすと.xls").Activate Rows("1:1").Select Selection.Insert Shift:=xlDown With Workbooks("てすと.xls").Worksheets(1).Range("A:A") Set c = .Find(fWord, LookIn:=xlValues) If Not c Is Nothing Then fAdd = c.Address Do c.Offset(-1, 0).EntireRow.Delete c.Offset(-1, 0).EntireRow.Delete c.Offset(0, 0).EntireRow.Delete Set c = .FindNext(c) '←ここからエラーとなってしまいます Loop While Not c Is Nothing And c.Address <> fAdd End If End With End Sub --- 「実行時エラー’1004’ Range クラスのFindNextプロパティを取得できません。」 とエラー表示されてしまいます。 --- 複数ある「"ああ"の行」の最上の1行だけにのみ実行されるだけです。 間違い箇所をご教示下さいませ。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセルVBA の変数を使うべきでしょうか？
はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If ・ ・ ・ ・ ・ ・ End Sub
- ベストアンサー
- オフィス系ソフト
- このコードに3行を追記しましたら、動作がだいぶ遅くなってしまった！
Windows XP Home Edition Service Pack 3 Office XP Personal 2002 Excel 2002 下記コードについて２点お伺いさせて下さいませ。 （１）●の3行を追記しましたら、動作がだいぶ遅くなりましたが、仕方ありませんでしょうか？ 記述する順序がいけませんでしょうか？ （２）●■が実行されません。 よろしくご教示お願い致します。 Sub TEST() Dim r As Range On Error Resume Next With Worksheets(Worksheets.Count) For Each r In .Range(Range("A2").End(xlDown).Offset(3, 2), .Range("A65536").End(xlUp).Offset(0, 25)) If r.Cells.Value >= 2 And r.Cells.Value <> 0 And r.Cells.Value <> "" Then With r.Offset(-38, 0) .Font.ColorIndex = 10 '緑色にする .Interior.ColorIndex = 36 '黄色にする .Borders.LineStyle = xlContinuous '● .Borders.Weight = xlMedium '●太線 .ColorIndex = 5 '●■紺色 '←ここが動作しません End With End If Next r End With
- ベストアンサー
- オフィス系ソフト
- インデックスが有効範囲に出ないと出る
下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか？？ Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト ").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp End Sub
- ベストアンサー
- オフィス系ソフト
- こんばんは、watabe007さん。
961awaawaです。 ＞シートモジュールに貼り付けてお試しください。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Intersect(.Cells, Range("L:M")) Is Nothing Then Exit Sub If .Row < 3 Or .Value = "" Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub .Offset(, 3).Value = Cells(.Row, .Value).Value End With End Sub というソースを作って頂いたのですが、既に各sheetにprivate sub からなるソースが入ってましてコンパイルエラー(名前が適切ではありません Worksheet_Change)となります。他に方法等頂けましたらありがたいです。
- ベストアンサー
- Excel（エクセル）
お礼
誠に、どうも有難うございました。 ばっちりでした。