- ベストアンサー
マクロでの次の実行マクロへの記述
下記のマクロを記述しました。 一つのマクロ処理を終わらせて、次のマクロ（例：test）を動かしたいのですが何処に 記述したら良いかわかりません。 教えてください。 Sub Macro1() Dim i As Integer Dim buff As String i = 2 While 1 If Range("B" & i).Value = "" Then End End If buff = Range("B" & i).Value Range("B" & i).Value = Left(buff, 7) + " " + Mid(buff, 8, 5) + " " + Right(buff, 6) i = i + 1 Wend Call test →ここに仮に記述したのですが、testのマクロに行きません。 End Sub 以上
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
gonta_gomaさんとほとんど同じ？違う？ Sub Macro1() Dim i As Integer Dim buff As String i = 2 buff = Range("B" & i).Value While buff <> "" Range("B" & i).Value = Left(buff, 7) & " " & Mid(buff, 8, 5) & " " & Right(buff, 6) i = i + 1 buff = Range("B" & i).Value Wend Call test End Sub
その他の回答 (1)
- gonta_goma
- ベストアンサー率50% (37/73)
このマクロには繰り返し終了条件が無く、Range("B" & i).Value = "" がTRUEになったところでマクロが終了しますのでtestは実行されません。 繰り返しを次の様にしたらどうでしょう。 While Not Range("B" & i).Value = "" buff = Range("B" & i).Value Range("B" & i).Value = Left(buff, 7) + " " + Mid(buff, 8, 5) + " " + Right(buff, 6) i = i + 1 Wend Call test
お礼
参考になりました。ありがとうございました。
関連するQ&A
- 教えてマクロの記述？
シート1に記述した内容をシート2に一覧形式で入力するマクロを以下の通り作成しました。 シート1に記述した内容を、別のブックのシートに一覧形式で入力していくマクロに変更するには どのようにマクロの記述をすれば宜しいのでしょうか？マクロの初心者にも分るようにご教授 いただければ助かります。よろしくお願いします。 Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub
- 締切済み
- オフィス系ソフト
- マクロが実行しない
二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub
- ベストアンサー
- Visual Basic
- すべてのシートでマクロを実行したい
以下のプログラムでは、選択したシートのみマクロが動作しています。ネット検索で見よう見まねで作ったため何がまちがっているのかわかりません。ご教示いただけるとありがたいです。 ・月の予定表で利用者が休みの日に斜線を引くマクロ ・入力ミスを防ぐためシート保護をしている Sub すべてのシート() Dim s As Worksheet For Each s In Worksheets s.Select Call 斜線 Next End Sub Sub 斜線() ActiveSheet.Unprotect Password:="1234" For i = 1 To Range("E10").End(xlDown).Row Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlNone If Range("E10").Value = 0 Then Exit Sub If Cells(i, "E").Value = "日" And Range("BP9").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "月" And Range("BP10").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "火" And Range("BP11").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "水" And Range("BP12").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "木" And Range("BP13").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "金" And Range("BP14").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "土" And Range("BP15").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "AY").Value = "祝日" And Range("BP16").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If Next i ActiveSheet.Protect Password:="1234" End Sub
- ベストアンサー
- Excel（エクセル）
- 実行中のマクロを中断したい
過日、「マクロの中断」について質問し適切な回答をいただき無事解決したものです。 ところが、初心者の悲しさ、少し変わると全く応用がききません。 Range("A1:B10")を読み上げている途中で中断したいのです。前回ご教示いただいたところにより 「DoEvents」や「Me.Repaint」「Sleep」などをあちこち挿入してみましたがうまくいきません。理屈、理論を理解できていないので仕方ないのでしょうがよろしかったら又ご指導のほどお願いします。Excel2003です。 Dim c As Range Dim CancelFlg As Integer Private Sub CommandButton1_Click() Range("A1:B10").Select CancelFlg = 0 For Each c In Selection ’ DoEvents Application.Speech.Speak c.Value ’ DoEvents If CancelFlg = 1 Then Exit For ’ DoEvents Next c Range("A1").Select End Sub Private Sub CommandButton2_Click() CancelFlg = 1 End Sub 前回のご教示いただいたもの Private Sub CommandButton1_Click() Dim i As Integer CancelFlg = 0 For i = 1 To 100 DoEvents ActiveCell.Value = 1 ActiveCell.Offset(1, 0).Activate Application.Wait (Now + TimeValue("0:0:01")) If CancelFlg = 1 Then Exit For Next i End Sub Private Sub CommandButton2_Click() CancelFlg = 1 End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ実行が遅い・・・
皆さんにおしえてもらいながら下記のようなマクロを組みました。 しかし、マクロを実行すると計算中が長いのです。 もしこのマクロに原因があれば教えてください。 よろしくお願いします。 －－－－－－－－－－－－－－－－－－－－－－－－－－ Sub 見積書作成() Sheets("見積書").Select '見積書シートを選択 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then '工数が「0」のときは Rows(i).RowHeight = 0 '行高さ「0」 End If Next For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next Dim Rng As Range Const Retu = "C" '<--- ここで「小計」の列を指定します。 For Each Rng In Range(Retu & "1", Range(Retu & "65536").End(xlUp)) If Trim(Rng.Value) = "小 計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub
- ベストアンサー
- オフィス系ソフト
- マクロに関するエラー（オブジェクトが必要です。）
マクロは始めてで、いろいろ調べながら作ってみたのですが、 Set検索値の行でオブジェクトが必要ですというエラーが出て、 先に進めなくなりました。 申し訳ないのですが、何方かエラーの対処法を教えていただけないでしょうか。 よろしくお願いします。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Sub test() Worksheets("2月分").Activate Dim 検索値 As Integer Set 検索値 = Worksheets("2月分").Cells(4, 18) Worksheets("テスト").Activate Dim B As Range Dim C As Range For Each B In Range("B13,B413") ' 第一条件 If B.Value >= 検索値 Then GoTo Continue End If ' 第二条件 If B.Offset(0, 1).Value < 検索値 Then ' Offset(0, 1) は B列の隣のC列の値を取得 GoTo Continue End If Dim aValue As String aValue = B.Offset(0, 2).Value Worksheets("2月分").Cells("D19").Value = aValue Continue: Next End Sub
- 締切済み
- その他（ビジネス・キャリア）
- 2つのマクロを1つにしたい
いつもお世話になっております。 今回もよろしくお願いいたします。 (1)14のシートがあるのですが、データーのある2から14までのシートを印刷する。 (2)上記のうち、ｃ列のデーターで連続しているセルを結合する。 (1)と(2)を合わせて1つのマクロにしたいのですが、アクティブシート１つにしか(2)のマクロが動きません。 下記のコードの間違いを教えてください。 Sub 契約書目次印刷() Dim Sh As Worksheet Dim t As Long Dim i As Range t = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'データーのあるシートだけ印刷 For Each Sh In Worksheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)) If Sh.Range("A2").Value <> "" Then '連続データーセル結合 For Each i In Range("C1:C" & t) If i.MergeArea(1).Value = i.Offset(1).Value Then Range(i.MergeArea, i.Offset(1)).Merge End If Application.DisplayAlerts = False Next i End If Sh.PrintPreview Next Sh End Sub
- ベストアンサー
- Excel（エクセル）
- 現マクロに列の塗りつぶし追加したい
マクロについては素人の私です。 図を参照いただきたいですが、J2にリストで「入金済み」と入力したとき下記のマクロでは F2 G2 I2 J2がグレーに塗りつぶしています。 但しE2には次のような式が入っています。 =IF(OR(B2="",C2=""),"",TEXT(B2,"yymmdd")&C2) このような式が入っていてもE2の塗りつぶしは可能でしょうか。可能ならば追加したいです。不可能ならE2は除きます。 もし可能ならばこれを B2 C2 D2 E2 もグレーでセルを塗りつぶすのを追加したいが下記のマクロをどうすればよろしいでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Long Dim r As Byte i = Sheets("入金記入").Range("B65536").End(xlUp).Row + 1 r = Target.Row If Target.Value = "入金済" Then With Sheets("入金記入") .Cells(i, 2).Value = Date .Cells(i, 3).Value = Cells(r, 3).Value .Cells(i, 4).Value = Cells(r, 4).Value End With End If End Sub ご指導の程、よろしく御願いします。
- ベストアンサー
- オフィス系ソフト
- 2つのマクロをうまく動かすにはどうしたら？
以下の2つのマクロを同時に動かそうとしています マクロ2はマクロ1で出した数字から始めの値段と終わりの値段と高安4つをエクセル関数で抽出して 出した4つの数字を24個蓄積することをめざしてます。 それぞれは1つで起動させるとうまく動くのですが 同時に動かすとマクロ1は4つずつ記録を始めたりと思い通りに動きません。 これを解決するにはどうしたらいいでしょうか？ Sub Macro1() Range("E65536").End(xlUp).Offset(1).Resize(1, 4).Value = Range("A2:D2").Value If Range("E65536").End(xlUp).Row > 30 Then '31行に到達してから１行目を削除する Range("E1:H30").Delete shift:=xlShiftUp End If Application.OnTime Application.Floor(Now, TimeSerial(0, 1, 0)) + TimeSerial(0, 1, 0), "Macro1" End Sub Sub Macro2() Range("I65536").End(xlUp).Offset(1).Resize(1, 4).Value = Range("A5:D5").Value If Range("I65536").End(xlUp).Row > 24 Then '25行に到達してから１行目を削除する Range("I1:L1").Delete shift:=xlShiftUp End If Application.OnTime Application.Floor(Now, TimeSerial(0, 30, 0)) + TimeSerial(0, 30, 0), "Macro2" End Sub 追加としてマクロ1は30分もしくは00分（9時00分、９時３０分、１０時１１時も同様）に記録を始めて ９時1分や31分には一旦削除最初から記録を蓄積するということを目指してます。 つまり１０時10分からマクロを動かすと１０時31分になると一旦削除して最初から始めるとうものです。 こちらも可能ならお願いします！
- ベストアンサー
- Excel（エクセル）
- マクロで色が同じになるように設定したい
こんにちは。 現在マクロに挑戦中なのですが、一点分からず戸惑っています。 お分かりになる方教えてください。 下記のマクロを書きました。 Sheet2のセルに数字を入れることによってSheet1のセルの色が変わるようにしています。 25以上の数字は全て青（カラー番号5）表示にしたいのですが、どのように記したら良のか教えてください。 --------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim i As Integer Dim j As Integer iColors = Array(36, 20, 24, 37, 40, 39, 17, 22, 45, 43, 28, 6, 4, 41, 18, 47, 50, 46, 10, 7, 3, 21, 9, 5) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i > 0 And i < 25 Then j = iColors(i - 1) Else j = 2 End If End If End If i = c.Row If i > 2 And j > 0 Then Worksheets("Sheet1").Range("B3:K6").Cells(i - 3).Interior.ColorIndex = j End If Next c End Sub --------------------------------------------------------------- お分かりになる方、宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
お礼
出来ました。ありがとうございました。