• ベストアンサー
  • 困ってます

エクセル2010を使用しています。

前回VBAについてご教授頂きました。 Private Sub Workbook_Open() 'この行から With Worksheets("Sheet1") If .Range("I20") <> Date Then .Range("H20") = .Range("H20") + 4000000 * ((Year(Date) - Year(.Range("I20"))) * 12 + Month(Date) - Month(.Range("I20"))) .Range("I20") = Date End If End With End Sub 'この行まで ここまで教えて頂きました。 一つ出来ると、別の欲が沸いてくるもので、次は、特定の月(4月、7月、10月、1月)に1000000ずつ増やしていきたいです。 度々申し訳ございませんが、ご教授頂きたいです。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数116
  • ありがとう数7

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1
noname#227064
noname#227064

> 一つ出来ると、別の欲が沸いてくるもので、次は、特定の月(4月、7月、10月、1月)に1000000ずつ増やしていきたいです。 あまりにも正直な気持ちを書かれているのに免じて、これにも回答しましょう。 以下のコードを.Range("I19")をDateに置換して使用してください。 .Range("I19")としたのはバグがないか確認用に使用しました。 Private Sub Workbook_Open() 'この行から With Worksheets("Sheet1") Dim diff As Integer ' 前回から今月までの経過月数 diff = (Year(.Range("I19")) - Year(.Range("I20"))) * 12 + Month(.Range("I19")) - Month(.Range("I20")) If diff > 0 Then ' 前回から一月以上経過したか? ' 前回の翌月から今月までにあった1,4,7,10月をカウント Dim n As Integer Select Case Month(.Range("I20")) Mod 3 Case 0: n = (diff + 2) \ 3 Case 1: n = diff \ 3 Case 2: n = (diff + 1) \ 3 End Select ' 数値の更新 .Range("H20") = .Range("H20") + n * 1000000 End If .Range("I20") = .Range("I19") ' 前回の日付を更新 End With End Sub 'この行まで 次は、ご自分で少し試行錯誤をしてから質問し、質問には自分で試してみたのは何か、どこが分からないのかを記載しましょう。 そうすれば次の質問にも、私を含めみなさん快く回答するかと思います。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

有難うございました!お陰様で理想的になりました。次回からは仰る通り自分で解決出来るように努力します。それでもわからない場合はまたお願いします。

関連するQ&A

  • Excelでシート名と最終更新日を自動表示したい

    Excelを使って (1)セルA1に入れた名目をシート名にし (2)セルH1には、最終更新日を自動で入れたいです。 調べた結果、 シート名を右クリックして「コードの表示」から (1)は Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub を入れてうまくいきましたが、 (2)は Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub を入れてみましたが(←調べましたもの) うまくいきませんでした。 単純に、 Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub とつなげて入れるのではだめなんでしょうか? それとも、(2)の何かが間違っていますか? ご教授願います。

  • 添削お願いします

    VBAが初心者で申し訳ありません。 Sub SetValue() If Month(Date) = 8 Then Sub ClearCell() Worksheets("Sheet4").Activate Worksheets("Sheet4").Range("K15").Clear End Sub End If End Sub 今が8月なら Sheet4 のセルK15 をクリアするものを作ろうとしましたが 上記で Date の部分が反転した状態で End Subが必要です とエラーが出ました。 ネット上の初心者向けサイトの切り張りをした状態で他の部分も間違いがあるかと思いますが どこがおかしいのでしょうか? 使用しているのはExcel2000です。

  • ユーザーフォームのデータ

    ユーザーファームを2つ作成しました。 そのユーザーフォームのデータを表の最終行に追加をしたいのです。 Range("A65536").End(xlUp).Offset(1,0).select を使おうと思っていますが、うまくいきません。 どなたか教えてください。 <ユーザーフォーム1> Private Sub CommandButton1_Click() Sheet2.Range("H7") = TextBox1 Sheet2.Range("I7") = TextBox2 Sheet2.Range("J7") = TextBox3 Sheet2.Range("K7") = TextBox4 Sheet2.Range("L7") = TextBox5 Sheet2.Range("P7") = TextBox6 If CheckBox1.Value = True Then Worksheets(2).Range("M7") = "0:30" Else Worksheets(2).Range("M7") = "0:00" End If If CheckBox2.Value = True Then Worksheets(2).Range("R7") = "1000" Else Worksheets(2).Range("R7") = "0" End If If CheckBox3.Value = True Then Worksheets(2).Range("S7") = "3000" Else Worksheets(2).Range("S7") = "0" End If If CheckBox4.Value = True Then Worksheets(2).Range("T7") = "1500" Else Worksheets(2).Range("T7") = "0" End If Unload Me End Sub <ユーザーフォーム2> Private Sub CommandButton1_Click() Sheet2.Range("V7") = TextBox1 Sheet2.Range("W7") = TextBox2 Sheet2.Range("X7") = TextBox3 Unload Me End Sub

  • セルの選択ができません。

    windws7 Excel2007でマクロ作成中の初心者です。 B列に8月21日から9月20日まで入力されてます。 以下のコードでセルBW28の数値によりセル選択範囲が異なります。 すべて8月21日の行から開始します。 28のときは、8月21日の行から28番目の行まで選択 29のときは、8月21日の行から29番目の行まで選択 30のときは、8月21日の行から30番目の行まで選択 以上正常にセルの選択が出来ます。 しかし31のとき 8月21日の行ただ1行しか選択してくれません。 上の例のように 8月21日の行から31番目の行、つまり9月20日までの行まで 選択したいのですが、どうしたらよいでしょうか。 Sub sersu sentaku() If Range("BW28") = 28 Then Range("B30").Resize(Day(DateSerial(Year(Date), Month(Date), 28)), 66).Select ElseIf Range("BW28") = 29 Then Range("B30").Resize(Day(DateSerial(Year(Date), Month(Date), 29)), 66).Select ElseIf Range("BW28") = 30 Then Range("B30").Resize(Day(DateSerial(Year(Date), Month(Date), 30)), 66).Select ElseIf Range("BW28") = 31 Then Range("B30").Resize(Day(DateSerial(Year(Date), Month(Date), 31)), 66).Select End If End Sub

  • 印刷後の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を選択するようにはどの様にしたらいいでしょうか?

  • エクセル・見積表の抽出印刷方法?その3

    先日(No.130709とNo.130958)、エクセルで作成した見積表の数量を入力した行のみを印刷したいとお聞きした者です。その際は、多くの方に回答を頂き、誠にありがとうございました。おかげさまで完成間近ですが、もう1つ問題が出てきてしまいました。宜しくお願いします。 商品によっては、行を追加し手で入力しなくてはならないものがあるので、あらかじめ空白行(金額列には0が入っています)を設けておきたいのですが、そうすると抽出した際、空白行も一緒に抽出されてしまいます。空白行がある場合は、下記の構文のやり方では無理なのでしょうか?空白行も非表示にしたいのです。 Private Sub CommandButton1_Click() Dim i As Integer i=2 Do Until i=-1 If Worksheets("Sheet1").Cells(i,1).Value=""Then i=-1 Else If Worksheets("Sheet1").Cells(i,6).Text=0Or_ Worksheets("Sheet1").Cells(i,6).Text=""Then Worksheets("Sheet1").Rows(i).Select Selection.EntireRow.Hidden=True End If i=i+1 End If Loop End Sub Private Sub CommandButton2_Click() Worksheets("Sheet1").Cells.Select Selection.Rows.Hidden=False End Sub 以上です。 宜しくお願いします。

  • このコードの修正点はありますか?

    Private Sub Clear() With Worksheets("abc") With .Range("A2", .Range("A" & Rows.Count).End(xlUp)) If .Row = 2 Then .EntireRow.Resize(, 7).ClearContents End If End With End With End Sub シートabcの、A2から最終行まで取得。 A2からA15までデータがあれば、それらの行のG列までクリア。 というコードですが、 If .Row = 2 Thenというのは、2行ならという意味ではないのですか? 1行でもデータがあればクリアにしてもらいたいのですが、 If .Row > 0 Thenみたいな感じにならないのでしょうか? 教えていただいたコードですが、この部分がわからないです。 ご教授くださいませ。

  • VBAについて

    VBAについて質問です。 データをコピーして新規ブックとして名前(年、月、日)をつけて別のフォルダ(デスクトップ上のフォルダ)に毎朝8時に保存したいのですが、Cディスク内に直接保存されてしまいます。 コードは以下の通りです。 Sub 自動保存() With workbooks("サンプル.xism") Worksheets("Sheet3").Range("B6:B205").Value = .Worksheets("メインモニタ").Range("F13:F212").Value Worksheets("Sheet3").Range("D6:D205").Value = .Worksheets("メインモニタ").Range("K13:K212").Value Worksheets("Sheet3").Range("F6:F205").Value = .Worksheets("メインモニタ").Range("P13:P212").Value Worksheets("Sheet3").Range("H6:H205").Value = .Worksheets("メインモニタ").Range("U13:U212").Value End With Worksheets("Sheet3").Select Worksheets("Sheet3").Copy Application.DisplayAlerts = False With ActiveWorkbook.SaveAs "C:\サンプル2_" & Format(Date , "yyyymmdd") . Close End With Application.DisplayAlerts = True Application.OnTime DateValue(Date + 1) + TimeValue("8:00:00") , "自動保存" Worksheets("メインモニタ") . Activate End Sub ご教授宜しくお願いします。

  • ExcelVBAで、必要な列を抽出する方法

    いつもお世話になっております Excelシートで、次のような表を作っています [Sheet1] A/B/C/D/E センター/氏名/生年月日/契約開始日/契約終了日 ※契約終了日のセルには計算式が入っていて、契約開始から18か月後の日付が出るようにしています。 また、G1セルに「契約終了月」、G2に「18」と入っています そこで、[Sheet2]に必要な行のみを抽出し、印刷するまでをしたいのですが、どのようにしたら良いのかわかりません 今できているのは、こんな感じです Private Sub CommandButton1_Click() Worksheets("Sheet2").Select Worksheets("Sheet2").Range("A:E").Clear With Worksheets("Sheet1") .Range("A:E").Copy Worksheets("Sheet2").Range("A1") .Range("A:E").AdvancedFilter _ Action:=xlFilterCopy, _ criteriarange:=.Range("G1:G2"), _ CopyToRange:=Worksheets("Sheet2").Range("A:F"), _ unique:=False End With If Application.CountA(Worksheets("Sheet2").Range("A:A")) > 1 Then MsgBox "今月末で契約終了です", vbOKOnly + vbInformation, "確認" If MsgBox("印刷しますか?", vbYesNo + vbQuestion, "印刷") = vbYes Then Worksheets("Sheet2").PrintOut End If Else MsgBox "今月で契約終了となる方はいません", vbOKOnly + vbInformation, "確認" End If Sheets("top_page").Select Range("A1").Select End Sub ※top_pageシートでコマンドボタンをクリックするとマクロ実行できるようにしています 連続する列の抽出の仕方はわかるのですが、例えば A列、B列、E列のみ を抽出させる場合どのようにしたらよいのか、アドバイスをお願いします できたら、抽出後、印刷までできるようなやり方がもっと簡単なのがあれば、教えていただけると助かります 色々勉強してはいるのですが、今一つわからないので、よろしくお願いします