- ベストアンサー
同じコードを毎月使いたい
ブック９月に次のコードを入れ計算しました。正常に使用できました。同じブック内での計算は、１回だけの設定です。 Private Sub 有給計算ボタン_Click() Application.ScreenUpdating = False Unload Me If Sheets("支給実績").Range("G1").Value = "" Then 個人別の作成 MsgBox "有給計算処理を終了しました." D符号部.Show Else ' セルG1に1が入っている場合 MsgBox "既に有給計算処理は終了しています。" D符号部.Show End If Sheets("支給実績").Range("G1").Value = "1" Application.ScreenUpdating = True End Sub このコードを複写して１０月分を計算しようとすると"G1には、 "1" が入って入るので計算しません。これをどんな月でも計算できるようにしたいです。どうしてでしょうか、ご教示お願いします。
- aitaine
- お礼率43% (170/393)
- Visual Basic
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
Application.ScreenUpdating = False の前に If MsgBox("新規計算ですか?", vbYesNo + vbDefaultButton2 + vbQuestion) = vbYes Then Sheets("支給実績").Range("G1").Value = "" End If として新規かどうか問合せをしてYesならG1の1を消すようにしておけばいかがですか。
関連するQ&A
- EDateエラーの回避コードをおしえてください
Excel2007でマクロ作成中の初心者です。 セルＧ2の1か月前の日付が、セルＭ5と同じときは、「計算済みです」として それ以外は、更新しますか？のコードを作成中 Private Sub CommandButton3_Click() Dim myBtn As Integer Dim myMsg As String, myTitle As String Sheets("計算").Select If EDate(Range("G2").Value, -1).Value = Range("M5").Value Then myMsg = Format(Range("G2").Value, "ggge年m月") & "分 は計算済みです。" & Chr(13) & "これを " & Format(Worksheets("管理").Range("D3").Value, "m月") & "分 に更新しますか？" myTitle = "単価の確認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) End If If myBtn = vbYes Then Exit Sub Sheets("計算").Select End If End Sub ここまで作ったら、If EDateのところで「コンパイルエラー」が発生します。エラー回避のコード教えてください。
- ベストアンサー
- Visual Basic
- VBAのコードを見ていただけませんか
いつも、ここのサイトの方々には大変お世話になっております。ありがとうございます。 さてexcel2000で、dataというフォームにデータを格納し、メインのシートから、読みに行って編集するデータベースを作成しようとしています。 とあるサイトを参考にして、コードを作成しましたが、いくら頑張ってもどうしてもエラーが出てしまいうまくいきません。 どうか、コードのチェック・修正内容の提案等をいただけないでしょうか？よろしくお願いいたします。 (1)自分で登録した「ＩＤが見つかりません」という表示しかでず、登録が出来ない (2)dataシートのＢ列（２列目）が主キー(ＩＤと呼んでいます） です。（メインのシートとデータを照合させる部分） (3)メインのシートのＩＤはAL1～AQ1行セルまでを結合したセルに保管しています。 (4)下記コードでCommandButton1ボタンを「登録」と命名し、メインシートで入力したデータをdataシートに変更登録、新規に入力したデータも登録できるようにしたい。 (5)スピンボタンでＩＤを変化させて、メインフォーム上のデータも変化させたいけど、こちらも同種のエラーが出てしまう。 ■以下コードです。 Private Sub CommandButton1_Click() Dim fRange As Range Dim fRow As Long If (Range("AL1").Value = "") Then 'IDが入力されていない場合 MsgBox "IDを入力して下さい", vbExclamation Exit Sub End If Set fRange = Sheets("data").Columns(2).Find(What:=Range("AL1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then 'IDが見つからなかった場合 MsgBox "IDが見つかりません", vbExclamation Exit Sub End If fRow = fRange.row 'IDの行位置を求める Sheets("data").Cells(fRow, 1).Value = Range("AZ1:BE1").Value Sheets("data").Cells(fRow, 2).Value = Range("AL1").Value Sheets("data").Cells(fRow, 3).Value = Range("AA1:AO1").Value Sheets("data").Cells(fRow, 4).Value = Range("D5:E5").Value Sheets("data").Cells(fRow, 5).Value = Range("G5").Value Sheets("data").Cells(fRow, 6).Value = Range("I5").Value Sheets("data").Cells(fRow, 7).Value = Range("D5:F7").Value Sheets("data").Cells(fRow, 8).Value = Range("G6:I7").Value Sheets("data").Cells(fRow, 9).Value = Range("E8:E9").Value Sheets("data").Cells(fRow, 10).Value = Range("G8:G9").Value Sheets("data").Cells(fRow, 11).Value = Range("B11:I24").Value Sheets("data").Cells(fRow, 12).Value = Range("B71").Value Sheets("data").Cells(fRow, 13).Value = Range("C71").Value Sheets("data").Cells(fRow, 14).Value = Range("B73").Value Sheets("data").Cells(fRow, 15).Value = Range("C73").Value Sheets("data").Cells(fRow, 16).Value = Range("B75").Value Sheets("data").Cells(fRow, 17).Value = Range("C75").Value ’・・・・全部でfRow122まであります End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA におけるブック終了後の値の保存方法について
ＥＸＣＥＬ ＶＢＡについて質問があります。もしかしたら初歩的なことかもしれませんがよろしくお願いいたします。 まず、 Sub Test() Dim i As String i = InputBox("好きな果物を入力してください") Sheets("Sheet1").Range("A1").Value = i End Sub を実行し、ブックを保存して終了する。 ブックを開く Private Sub Workbook_Open() Dim k As String k = Sheets("Sheet1").Range("A1").Value If k = "みかん" Then MsgBox ("a") Else: MsgBox ("b") End If End Sub この処理を Sheets("Sheet1").Range("A1").Value = i というシート上のセルに値を保存するという方法を取らずに iの値をブック終了後もプロシージャ内に持っておくというのは可能なのでしょうか。 Publicで宣言してもブックを一度閉じると やっぱりiの値は保存されませんでした。 どうぞよろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- このコードが、うまく実行できません！
下記の実行後のようにしたのですが、うまく出来ません、 何卒、ご教示くださいませ。 EXEL 2002 です。 ------------------------------------ Sub 数に対してマークを付ける() Dim c As Range Workbooks(1)..Sheets(1).AutoFilter.Range.Cells(1, 5).Select For Each c In Range(Selection, Sheets(1).AutoFilter.Range.Cells(1, 5).End(xlDown)).Select Select Case c.Value Case Is = 0 c.Offset(0, -3).Value = "×" Case Is = 1 c.Offset(0, -3).Value = "△" Case Is = 2 c.Offset(0, -3).Value = "○" Case Else MsgBox "対象の数字がありません" End Select Next End Sub --実行前------------------- Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ １ ・ ・ ・▼▼▼▼▼▼▼▼←オートフィルターのマーク ・ 0 ・ 2 ・ 1 ・ 0 50 ・ --実行後------------------ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ １ ・ ・ ・▼▼▼▼▼▼▼▼←オートフィルターのマーク ・ × 0 ・ ○ 2 ・ △ 1 ・ × 0 50 ・ ---------- よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- VBA コマンドボタンにおけるコードについて
下記のようなコードを作成しました。 これを簡略化するにはどうすれば良いのでしょうか？ よろしくお願いします。 Private Sub CommandButton1_Click() Sheets("sheet2").Select Select Case UserForm1.ComboBox1.Text Case Is = Sheets("sheet2").Range("A1").Value Sheets("sheet2").Range("B1").Value = "X" Case Is = Sheets("sheet2").Range("A2").Value Sheets("sheet2").Range("B2").Value = "X" Case Is = Sheets("sheet2").Range("A3").Value Sheets("sheet2").Range("B3").Value = "X" Case Is = Sheets("sheet2").Range("A4").Value Sheets("sheet2").Range("B4").Value = "X" Case Is = Sheets("sheet2").Range("A5").Value Sheets("sheet2").Range("B5").Value = "X" ・ ・ ・ End Select End Sub
- ベストアンサー
- Visual Basic
- エクセルのエラートラップについて
エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになります. そこで以前エラートラップの方法を教えて頂きました。 オフィス２００７では正常に動作します。 試しにオフィス２０００で実行するとDATAシートにデーターがあるなしに関わらずDATAシートにデーターがないと処理してしまうのですがエクセル２０００では無理なのでしょうか？ また回避方法があれば教えて頂きたいのですが、まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value On Error GoTo MSG Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True Exit Sub MSG: MsgBox "DATAシートにデーターがない", vbCritical Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- VBAでエラー時にメッセージを表示したい
こんばんわ！ エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか？ まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- 印刷シートを分けたい
excel2010を使用しています、今勉強中の初心者です、 dataシートに履歴を残すようにしています、dataシート列 Ｌ列に番号１が表示された場合のみSHEET4を印刷し、そうで無い場合SHEET5を刷したいですが、ご教授ください。 Sub rireki() Dim val(1 To 12) Dim lastRow As Long val(1) = Range("AH5").Value val(2) = Range("AJ3").Value val(3) = Range("AJ5").Value val(4) = Range("AK5").Value val(5) = Range("G2").Value val(6) = Range("AI5").Value val(7) = Range("B2").Value val(8) = Range("B5").Value val(9) = Range("E5").Value val(10) = Range("C3").Value val(11) = Range("V2").Value val(12) = Range("V3").Value Application.ScreenUpdating = False With Sheets("data") lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row End With Sheets("data").Range("A" & lastRow).Offset(1).Resize(, 12) = val Sheets("Sheet4").PrintOut Copies:=1, Collate:=True ActiveWorkbook.Save Application.ScreenUpdating = True End Sub
- 締切済み
- Visual Basic
- エクセルのマクロコードについて
お世話になります。 下記コードで、セルごとにクリアをすると、エラーなくうごくのですが、セルをまとめてセルを消すと実行時エラー13型が一致しません。とでてIf Target.Value = "" Thenがだめだよとでてしまいます。 どなたか、回避の方法をご教授ください。 宜しくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B2:E2,G2:J2")) Is Nothing Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo 'Range("B2").Value = x + Z Z = Target.Offset(1, 0).Value y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With Target.Offset(1, 0).Value = x + Z End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBAでもっと早く転記
エクセル2000です。 以下は、列をコピーし行にペーストする作業を含むVBAですが、もっとスマートに早く転記する方法がありましたらご教示ください。 お願いします。 Sub TEST() With Application .ScreenUpdating = False .Calculation = xlCalculationManual Sheets("データ").Range("B8:DH8").ClearContents With Sheets("入力") .Range("G8:G68").Copy Sheets("データ").Range("C8:BK8").PasteSpecial Paste:=xlValues, Transpose:=True .Range("G14:G15").Copy Sheets("データ").Range("BM8:BN8").PasteSpecial Paste:=xlValues, Transpose:=True Sheets("データ").Range("BQ8") = .Range("G21") Sheets("データ").Range("BR8") = .Range("G23") .Range("G25:G29").Copy Sheets("データ").Range("BS8:BW8").PasteSpecial Paste:=xlValues, Transpose:=True .Range("G32:G68").Copy Sheets("データ").Range("BX8:DH8").PasteSpecial Paste:=xlValues, Transpose:=True End With Application.CutCopyMode = False .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub
- ベストアンサー
- オフィス系ソフト
お礼