- ベストアンサー
VBAの繰り返し処理について
- VBAの繰り返し処理について、複数のシートに同じ処理を適用したいと考えています。現在のコードでは正しく動作していますが、改善の余地があるかもしれません。
- 現在、VBAの繰り返し処理を使用して、複数のシートに同じ処理を適用しようとしています。コードは正常に動作していますが、もっと効率的に実装する方法があれば教えてください。
- VBAの繰り返し処理を使用して、複数のシートに同じ処理を適用したいと思っています。現在のコードでは動作していますが、より効率的な方法があればお教えください。
- hotspace
- お礼率60% (3/5)
- Visual Basic
- 回答数2
- ありがとう数9
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- n-jun
- ベストアンサー率33% (959/2873)
Sub try() Dim i As Integer For i = 2 To 8 ' 左から２～８番目のシートが対象 With Worksheets(i).Range("A2:A3176") ' セルＡ２～Ａ３１７６ ' 数式を入れる .Formula = "=IF(AND(B2=C2,C2=D2),B2,IF(B2=C2,D2,IF(C2=D2,C2,"""")))" ' 値に変換する .Value = .Value End With Next End Sub 値を入れるだけで良ければ参考になるかもです。
お礼
回答いただきまして、ありがとうございます。 こちらの説明不足で申し訳ありませんでした。 値だけではなく、書式や条件等も反映させたい為、上記のような 記述になりました。お手数をおかけして申し訳ございませんでした。
関連するQ&A
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
- 印刷後のVBAの実行 (2)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?
- 締切済み
- オフィス系ソフト
- VBA beforeprintについて
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "sheet1" Then If Range("M1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("M1").Select Exit Sub End If ElseIf ActiveSheet.Name = "sheet2" Then If Range("A47").Value = 文字 Then Cancel = True MsgBox ("日付を入力してください") Range("A47").Select Exit Sub End If Exit Sub End If End Sub 上記は印刷をする前に実行されるコードですが、上記を実行して印刷をした後に自動で下記のVBAを実行したいのですが Sub データー取り込み() ActiveSheet.Range("B2000:Z2000").Copy ChDir "\\データーA\データーB\データーC\データーD" Workbooks.Open Filename:="\\データーA\データーB\データーC\データーD\データーシート1.xls" Sheets("顧客データー").Select If Worksheets("顧客データー").Range("B18").Value = "" Then Worksheets("顧客データー").Range("B18").PasteSpecial Paste:=xlPasteValues Else Worksheets("顧客データー").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If ActiveWorkbook.Save ActiveWindow.Close End Sub 上記のコードと下記のコードをどのように絡めたらいいのかわかりません。アドバイスお願いします。
- ベストアンサー
- オフィス系ソフト
- 【Excel VBA】ワークシートの表示(続き)
すみません。 追記が出来なかったため、コードの続きをこちらに記載します。 For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか？", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Exit For ElseIf Anser = vbNo Then Exit For End If End If Next If Flag = O Then MsgBox ("新しいワークシートを作成出来ません。") End If If actsht = tmp(i) Then If Sheets(元データ).Visible = False Then Sheets(元データ).Visible = True End If End If End Sub
- 締切済み
- 情報工学
- VBAである一定以上の数値を検索して、処理を行うようにしたいのですが…
VBAである一定以上の数値を検索して、処理を行うようにしたいのですが… 初めまして。 業務で効率化を図るための簡易ソフトのようなものを作るため、VBAを勉強しています。 VBAである一定以上の数値をＡシートのある範囲から検索して、ある一定以上の数値が1個以上であればテキストボックスにＡシートのあるセルの言葉を表示させたいと考え、以下のようなものを作りましたが、「オブジェクト変数またはWithブロック変数が設定されていません」と出てしまいます。 どなたかご教授下さればとても助かります。 ちなみにExcel2007です。 Private Sub CommandButton1_Click() Dim Target1 As Variant Target1 = Worksheets("A").Range("D8:V8").Find(">=10") TextBox1.Text = "" Me.TextBox1.Font.Size = 14 If OptionButton1 = True Then If Target1 >= 1 Then Worksheets("A").Range("B33").Copy Me.TextBox1.Paste Application.CutCopyMode = False ElseIf Target1 = 0 Then Worksheets("A").Range("B34").Copy Me.TextBox1.Paste Application.CutCopyMode = False End If End If End Sub
- ベストアンサー
- Visual Basic
- Excelの三つのVBAを一つにまとめる。
初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 解る方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
- ＥＸＣＥＬのＶＢＡについて
マクロのボタンで内容を削除する様に設定した所、 Dim re As Integer Sheets("投入シート").Select re = MsgBox("入力データをクリアします。" & vbCrLf & vbCrLf & "よろしいですか？", vbOKCancel, "クリア確認") If re <> vbCancel Then Sheets("投入シート").Select ActiveSheet.Unprotect Range("a1:c30").Select Selection.Copy Application.CutCopyMode = False Selection.Copy Sheets("work").Select Range("A1").Select ActiveSheet.Paste Sheets("投入シート").Select ActiveSheet.Unprotect Range("c4:c30").Select Selection.ClearContents Range("f31").Select Selection.Copy Range("c9").Select ActiveSheet.Paste Range("f33").Select Selection.Copy Range("c11").Select ActiveSheet.Paste Range("f32").Select Application.CutCopyMode = False Selection.Copy Range("c14").Select ActiveSheet.Paste Range("c4").Select Application.CutCopyMode = False 'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If Sheets("投入シート").Select Range("c4").Select End Sub この様に入力したのですがセルのＣ１１の計算式だけセル番号が消えてしまいます。 どうしてでしょうか？ご指導をお願いします。
- ベストアンサー
- その他MS Office製品
- 複数ファイルへのVBAの処理について
最近、ExcelのVBAを使うようになりました。 しかし、以下のような処理を同じフォルダ内の複数のファイルに対して一気にやりたいのですが、わかる方いらっしゃいませんか？ 理想としては同じフォルダ内で50個くらいを選択して一気にやりたいのですが・・・。 ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ Sub FFT() Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(18, 1)), TrailingMinusNumbers:=True Range("E8").Select Application.Run "ATPVBAEN.XLA!Fourier", ActiveSheet.Range("$B$1:$B$256"), _ ActiveSheet.Range("$C$1:$C$256"), False, False Columns("C:C").ColumnWidth = 38.38 Range("D1").Select Columns("D:D").ColumnWidth = 20.75 Range("D1").Select ActiveCell.FormulaR1C1 = "=IMABS(RC[-1])" Range("D1").Select Selection.Copy Range("D1:D256").Select ActiveSheet.Paste Range("E6").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "" Range("E7").Select End Sub
- 締切済み
- Visual Basic
- 【Excel VBA】フォームボタンの操作
IF文の中でフォームボタンを自動でクリックする処理を追記したく、 以下のコードで実行しましたが、エラーとなりました。 IF文のSubプロシージャが閉まっていないと弾かれたのですが、 どう修正すれば正常に機能しますでしょうか？ ここから↓ actsht = ActiveSheet.Name For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか？", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Private Sub clear_Click() '※ End Sub '※ Exit For ElseIf Anser = vbNo Then Exit For End If End If Next
- 締切済み
- 情報工学
- Excel VBA セルの双方向同期のエラーについ
エラーが発生して理由がわからないので、どなたか助言をお願いします。 以下のVBAにて、目的のセルにデータを入力すると、1回目は必ず添付写真の通りのエラーが出まして、デバッグをすると3行目が黄色でハイライトされます。 記述は以下の通りです。どうぞよろしくお願いします。 シートAへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("シートB").Range("$B$1").Value = Sheets("シートA").Range("$A$1").Value End If End Sub シートBへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("シートA").Range("$A$1").Value = Sheets("シートB").Range("$B$1").Value End If End Sub
- ベストアンサー
- Visual Basic
お礼
回答いただきましてありがとうございます。 実はシート１にはこれは反映させたくなく、さらにシート名がそれぞれ付いていて （sheet2は"２枚目"、sheet3は"３枚目"などと名前がついています）シート２からシート８までのみ反映させたいのです。 この場合はどのように記述したらよいのでしょうか？