- ベストアンサー
コンパイルエラー:が出るようになった
kkkkkmの回答
どこかに Sub Len() Sub Replace() のような同名のプロシージャを作成していないでしょうか。 エラーで選択されるほうです。
関連するQ&A
- VBA どこでもセル選択
教えて頂いたVBAなのですがもう一つ Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j Counter = Counter + 1 If INP <> "" Then wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub -------------------------------------------------------------- For i = 3 のところを3としないでどのセル(行)にも対応させたいのですが どうすればいいでしょうか?
- ベストアンサー
- Excel(エクセル)
- シート1の氏名をシート2に反映
sheet1の氏名をsheet2の日付、記号(A,B,C)にマッチした位置に入力させたいのですが下記コードで他で試したのですがうまくいきません。どなたかコードが解る方よろしくお願いします。 Sub 入力() Dim i As Long, j As Long, k As Long, L As Long Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") i = wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)) j = wS2.Cells(3, Columns.Count).End(xlToLeft).Column Range(wS2.Cells(3, 2), wS2.Cells(i, j)).ClearContents On Error Resume Next For i = 2 To wS1.Cells(Rows.Count, 4).End(xlUp).Row If WorksheetFunction.CountA(wS1.Rows(i)) > 1 Then For j = 2 To wS1.Cells(i, Columns.Count).End(xlToLeft).Column If wS1.Cells(i, j) <> "" Then k = WorksheetFunction.Match(wS1.Cells(i, 4), wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)), False) L = WorksheetFunction.Match(wS1.Cells(5, j), wS2.Rows(3), False) wS2.Cells(k, L) = wS1.Cells(i, j) End If Next j End If Next i End Sub
- ベストアンサー
- Visual Basic
- Excel 2007 マクロ 別シートの情報を反映する方法
Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
- エラー Nextに対するForがありませんについて
VBAに慣れていないのですが、下記のマクロを組んでみました。 実行すると、コンパイルエラー Nextに対するForがありませんと出てしまいました。 原因が良く解らないので解る方いらっしゃいましたら教えてください。 それと、もっと良い書き方などありましたらアドバイスを下さい。 よろしくお願いします。 Sub レポート作成2each() Dim ReportMaxRow As Long '上方向に最終行を検索し行番号を格納 Dim AddWsName As String 'シート名格納 Dim Ws As Worksheet 'オブジェクト格納 Dim i As Long '繰り返しのカウントを格納 Dim flag As Boolean '真偽 ReportMaxRow = Worksheets("レポート元").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To ReportMaxRow If Cells(i, "N").Value <> "" Then If Cells(i, "O").Value <> "" Then AddWsName = Cells(i, "K").Value For Each Ws In Worksheets If Ws = AddWsName Then flag = True Next Ws ←ここでエラーになります。 If flag = True Then Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _ Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Else Worksheets.Add ActiveWorksheet.Name = AddWsName Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _ Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します, _ vbOKOnly + vbExclamation, "お知らせ" End If Else MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します", _ vbOKOnly + vbExclamation, "お知らせ" End If Next i End Sub
- ベストアンサー
- その他(プログラミング・開発)
- 番号を振るvbaで悩んでいます。
本を読みながら作ったのですが、全然動いてくれません。 Sheet1に A B 1 2開始日 2月12日 3開始時間 8:30 4終了時間 12:00 5間隔/ 分 5 6人数/コマ 8 という情報が入っています。 Sheet2には A2から番号が振ってあります。2000件くらいあります。 それに次の条件で番号を振りたいのです。 8時30分から12時までの間で8人毎に5分間下記の時間を振り分けたいのです。 12時を過ぎると翌日の8時半からまた同じことを繰り返します。 Sheet1の情報は毎回変更しますので、変数を使いたいと思っています。 A B C 1 2 1001 2/12 8:30 3 1002 2/12 8:30 : : : : : 1008 2/12 8:30 : 1009 2/12 8:35 : 1010 2/13 8:35 : : : : : : : : : 1336 2/13 8:30 : : : : Sub test() Dim strdate As Date, strtime As TimeValue, endtime As TimeValue Dim i As Long, c As Long, j As Long strdate = Worksheets(2).Range("b2").Value strtime = Worksheets(2).Range("b3").Value = TimeValue("8:30") endtime = Worksheets(2).Range("b4").Value = TimeValue("12:00") Range("b:b").NumberFormatLocal = "h:mm" i = Worksheets(2).Range("b5").Value c = Worksheets(2).Range("b6").Value If strtime < endtime Then Do While strtime < endtime For j = 1 To c Worksheets(1).Cells(j, 0) = strdate Worksheets(1).Cells(j, 1) = strtime Next j strtime = DateAdd("m", 5, strtime) Loop Else strtime = Worksheets(2).Range("b3").Value Do Until strtime = endtime For j = 1 To c Worksheets(1).Cells(j, 0) = strdate + 1 Worksheets(1).Cells(j, 1) = strtime Next j strtime = strtime + 5 Loop End If End Sub これでは全く動きませんでした。 また、strtimeをtimevalueで宣言するとオブジェクトを要求され、結果変数ではなく 直接データを入れることになってしまい、目的を果たせません。 初心者がやることではないなと思いましたが、これが出来ると、私たちの仕事が 画期的に向上するので、是非今回は苦労しても作り上げたいと思いました。 プロの方々はこういう場合、私はIf ⇒Do Loop⇒For Nextをネストしましたが、 どういう風に考えられるのでしょうか?それも興味があります。 よろしくアドバイスお願いします。<m(_ _)m>
- ベストアンサー
- Visual Basic
- マクロ エラーに関して
91個のデータを以下のように10個ずつ横に並べ、 同じ数値のデータN列よりグラフを作成し、 A:Jの数値を変更した場合 N列に同期しグラフが変更される。 また、グラフのプロット(数値)が変更された場合も N列が変更され A:Jの数値と同期し変更するように考えています。 しかし、以下の現象でうまく動作しませんので教えて頂ければと思います。 A1⇒J1 = N1:N10 A2⇒J2 = N11:N20 A3⇒J3 = N21:N30 A4⇒J4 = N31:N40 A5⇒J5 = N41:N50 ⇔ グラフ A6⇒J6 = N51:N60 A7⇒J7 = N61:N70 A8⇒J8 = N71:N80 A9⇒J9 = N81:N90 A10 = N91 【現象】 (1) A:Jの数値を変更した場合にエクセルがフリーズしたような状態になり操作が出来なくなる。 (2) グラフのプロット(数値)が変更された場合にA:Jの数値が変更されない もしくは、以下の部分でメッセージが表示されます。 NFromAJの以下の転記部分 Worksheets("PAT_01").Cells(tmp \ 10, tmp Mod 10 + 1).Value = Worksheets("PAT_01").Cells(i, "N").Value 【エラーメッセージ】 実行時エラー'13’ 型が一致しません。 【現在のソース】 '----------------------------------- Sheet1 モジュール Option Explicit Private LastTarget As Variant Private WithEvents Chart1 As Chart '対象埋め込みグラフに関連付けるChartクラス Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Chartクラスを「このワークシートの埋め込みグラフ1」 に関連付ける〔Chartobject 番号★要修正〕 If Chart1 Is Nothing Then Set Chart1 = Me.ChartObjects(1).Chart End If '現在のN列の値を IDプロパティにCopyしておく If Len(Range("N2").ID) = 0 Then Dim c As Range For Each c In Range("N1:N91") c.ID = CStr(c.Value2) Next MsgBox "N列の値を IDプロパティにCopyしました" End If End Sub '(1) A:Jのほうで変更があったとき Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, tmp As Long If Not Application.Intersect(Range("A1:J9,A10"), Target) Is Nothing Then If Target.Value <> LastTarget Then Application.EnableEvents = False For i = 1 To 91 tmp = i + 9 Cells(i, "N").Value = Cells(tmp \ 10, tmp Mod 10 + 1).Value Next Application.EnableEvents = True End If End If End Sub '(2) グラフの系列1のPointがドラッグされ値が変更されたとき Private Sub Chart1_Calculate() Module1.NFromAJ End Sub '----------------------------------- 標準モジュール(Module1) Option Explicit Sub NFromAJ() Dim i As Long, tmp As Long For i = 1 To 91 tmp = i + 9 Worksheets("PAT_01").Cells(tmp \ 10, tmp Mod 10 + 1).Value = Worksheets("PAT_01").Cells(i, "N").Value Next End Sub
- 締切済み
- その他(プログラミング・開発)
- VBA 空白表示させたい
教えて頂いたVBAなのですが Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents If Selection(Selection.Count).Row <> 2 Then Exit Sub Counter = 0 For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j If INP <> "" Then Counter = Counter + 1 wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub ---------------------------------------------------------------------- g h i j パセリ クレソン メキャベツの葉 ごぼう 1 1 1 1 1 1行目 パセリ,クレソン,メキャベツの葉 2行目 3行目 パセリ,メキャベツの葉 と、2行目は詰めずに空白表示したいです。 どこをどうすればできますか?
- ベストアンサー
- Excel(エクセル)
- マクロで文字列をブック全体に一括置換する
'マクロで一括置換する方法です。 'たくさんのシートに記入された文字列を複数のシートに渡って一括置換する方法を教えてください。 '置換前と置換後の文字をインプットボックスに記述しブック全体の文字を一括で置換(変更)する 'その後は戻せなくても結構です。 下のように記述しましたが、うまく動作しません よろしくお願いします。 Private Sub CommandButton11_Click() Dim BeforeStr As Integer Dim AfterStr As Integer Dim WS As Worksheet Dim N As Integer For N = 1 To Worksheets.Count Set WS = Worksheets(N) For i = 1 To 100 For j = 1 To 200 Before.Cells(i, j).Value = InputBox("置換前の文字列を入力してください。") After.Cells(i, j).Value = InputBox("置換後の文字列を入力してください。") For Each WS In Worksheets WS.Activate For Each s In WS.Cells If s.Name Like "InputBox*" Then s.Select Selection.Cells(i, j).Value = _ Replace(Selection.Cells(i, j).Value, BeforeStr, AfterStr) End If Next j Next i Next N Next End Sub
- 締切済み
- オフィス系ソフト
- Excel 2007 マクロのIF構文について
Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
- 抜き出しマクロ(3)
以下のプログラムは10行ごとにデータを抜き出すプログラムです。 これに追加して、普段は10行に1個データを抜き出し、前回の結果より絶対値が10増減があったとき、 相対値が10%の増減があった時にもデータを抜き出すようにするにはどうすればいいですか? 例えば以下の通り time result 1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1 11 100 12 500 13 1000 14 1000 15 1000 16 1000 17 1000 18 1000 19 1000 20 1000 21 1000 ・ ・ ・ ・ ・ ・ ↓ time result 1 1 10 1 11 100 12 500 13 1000 20 1000 ・ ・ ・ ・ ・ ・ ここからプログラム(10行ごとに抜き出す) ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ Sub nukitori() Dim X As Worksheet Dim i As Long Dim ii As Long Dim col As Integer Dim Nukitori_Step As Long Nukitori_Step = 10 i = 2 ii = 2 '●●●見出し行が1行目なので2で始める Set X = ActiveSheet '●シートShordataがあったら削除 On Error Resume Next Application.DisplayAlerts = False Worksheets("shortdata").Delete Application.DisplayAlerts = True On Error GoTo 0 Worksheets.Add.Name = "shortdata" '●先ず、見出しをコピー Worksheets("shortdata").Rows(1).Value = X.Rows(1).Value While X.Cells(i, 1) <> "" And i < 65535 For col = 1 To 255 Worksheets("shortdata").Cells(ii, col).Value = X.Cells(i, col).Value Next If i = 2 Then i = 1 i = i + Nukitori_Step ii = ii + 1 Wend End Sub ここからプログラム(10行ごとに抜き出す+増減があった場合も抜き出す) ただし以下の箇所でエラーが起こる If i > 3 And Abs(Cells(i, 1) - Cells(i - 1)) >= 10 Then 中断モードでコードを実行することができませんと。 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ Sub 抽出() Dim i As Long Dim j As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim Lastline As Long Dim SelFlg As Boolean '抽出データかどうかの Set ws1 = Worksheets("OriginDT") '元データ Set ws2 = Worksheets("SelectDT") '抽出データ Lastline = ws1.Cells(Rows.Count, 1).End(xlUp).Row '最終行番号を取得 ws2.Cells(1, 1) = ws1.Cells(1, 1) '見出し部分のコピー ws2.Cells(1, 2) = ws1.Cells(1, 2) j = 1 For i = 2 To Lastline SelFlg = False '10で割ったあまりが1(つまり10行おき)または最初のデータのとき If i Mod 10 = 1 Or i = 2 Then ' SelFlg = True '抽出対象にする End If '2行目以降で一つ上の行との差が10以上のとき If i > 3 And Abs(Cells(i, 1) - Cells(i - 1)) >= 10 Then SelFlg = True '抽出対象にする End If If SelFlg = True Then '抽出対象だったらコピー j = j + 1 ws2.Cells(j, 1) = ws1.Cells(i, 1) ws2.Cells(j, 2) = ws1.Cells(i, 2) End If Next End Sub
- 締切済み
- Visual Basic
お礼
kkkkkmさん、アドバイス感謝します。 アドバイスのように sub Replace()が存在しています。 sub NewReplace()に名前を変更してエラーが出なくなりました。 値の確認などは、msgboxやDebug.Printを使って確認できるのですが 今回の「コンパイルエラー」の場合は、どうチェックすれば良いのか判らなくて マクロを操作中に何処か?修正ミス(一部のミス削除など)が合ったのかと 色々見直していましたが判りませんでした。 単純に後から作成したSUB名に原因が有るとは思いも依らないことでした。