[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『月を加算したシートネームから値を書き込みたい』(nobu)
以下にて最終???部分で良いと思うのですが(自信ないですが)
新しく作成した1ヶ月足したシートネームから取得しB4に取得した月の
最終日を書き込みたいのですが、ご指導お願いします。
よろしくお願いします。
Sub 1ヶ月加算()
Dim sh_name As String Dim d As Date Dim ws As Worksheet Dim n As Long
With ActiveSheet
If Len(.Name) = 6 And IsDate(Left(.Name, 4) & "/" & Right(.Name, 2) & "/1") Then ' その日付を取得 d = CDate(Left(.Name, 4) & "/" & Right(.Name, 2) & "/1")
sh_name = Format(DateSerial(Year(d), Month(d) + 1, 1), "yyyymm") Else MsgBox "アクティブシートが月のシートではありません" Exit Sub End If End With On Error Resume Next Set ws = Worksheets(sh_name) On Error GoTo 0 If Not ws Is Nothing Then MsgBox "次月のシートは既に存在します" ws.Move After:=ActiveSheet Worksheets(Format(d, "yyyymm")).Activate Exit Sub ' 処理終了 End If
ActiveSheet.Copy After:=ActiveSheet With ActiveSheet .Name = sh_name n = .Range("C" & .Rows.Count).End(xlUp).Row If n >= 4 Then .Range("B4:Q" & n).ClearContents ' 範囲を消去 .Range("I4:I35").Formula = "=IF(G4>0,F4-G4,"""")" .Range("N4:N35").Formula = "=IF(RC[-3]>0,RC[-7]-RC[-3]-RC[-2]-RC[-1],"""")" .Range("O4:O35").Formula = "=IF(RC[-1]="""","""",RC[-1]*1.08) End With
' 「B4」にシートネームから取得し日付書込 Range("B4").Value = DateAdd(????, sh_name)
End Sub
< 使用 Excel:Excel2013、使用 OS:Windows7 >
Sub test() Dim d As Date
d = Date MsgBox DateSerial(Year(d), Month(d) + 2, 0)
End Sub
(マナ) 2015/02/24(火) 20:16
Sub test() Dim sh_name As String Dim d As Date Dim ws As Worksheet Dim n As Long
With ActiveSheet If Len(.Name) = 6 And IsDate(Left(.Name, 4) & "/" & Right(.Name, 2) & "/1") Then d = DateSerial(Left(.Name, 4), Right(.Name, 2), 1) sh_name = Format(DateAdd("m", 1, d), "yyyymm") Else MsgBox "アクティブシートが月のシートではありません" Exit Sub End If End With
On Error Resume Next Set ws = Worksheets(sh_name) On Error GoTo 0 If Not ws Is Nothing Then MsgBox "次月のシートは既に存在します" ws.Move After:=ActiveSheet Worksheets(Format(d, "yyyymm")).Activate Exit Sub ' 処理終了 End If
ActiveSheet.Copy After:=ActiveSheet With ActiveSheet .Name = sh_name n = .Range("C" & .Rows.Count).End(xlUp).Row If n >= 4 Then .Range("B4:Q" & n).ClearContents ' 範囲を消去 .Range("I4:I35").Formula = "=IF(G4>0,F4-G4,"""")" .Range("N4:N35").Formula = "=IF(RC[-3]>0,RC[-7]-RC[-3]-RC[-2]-RC[-1],"""")" .Range("O4:O35").Formula = "=IF(RC[-1]="""","""",RC[-1]*1.08)" .Range("B4").Value = DateAdd("m", 2, d) - 1 ' 「B4」にシートネームから取得し日付書込 End With End Sub (???) 2015/02/25(水) 09:18
横から失礼します。
【ランダムにシートタブカラーを変える】
ランダムに変えたい理由がいまいち、わからないのですが? むしろ、1月は青、2月は黄色、3月は水色、・・・といったように12か月分を決めておけば 色を見るだけで何月のシートなのかが直感的にわかるのでは?と思いますが。
仮に、【ランダム】だとして、xl2013で使用可能な色は 0 〜 16,777,216 あるわけで、 これらのなかから、どの色でもいい、ランダムに? 意図しないような色が選ばれるかもしれませんよ。 それでよければ、乱数で、0 〜 16,777,216 の整数の間から1つ取り出すことはできますけどね。
同じランダムでも、候補を、たとえば20種億ぐらいに決めておいて、1〜20の整数を取り出して 1なら 赤、2なら青 といったような制御のほうが現実的?
でも、それなら、月別に色を決めておいたほうがよろしいかと思いますが?
(β) 2015/02/25(水) 10:42
日付書き込みした直後あたりに、以下を追加。 .Tab.Color = Array(vbRed, vbBlue, vbGreen, &H99FFFF, vbCyan, &H99FF99, vbYellow, vbBlack, vbWhite, vbMagenta, &HF0B000, &H50D092)(Month(d) - 1) (???) 2015/02/25(水) 13:07
ランダムっぽい順番より、規則性のある色のほうが綺麗に見えると思いますが、いかが? .Tab.Color = Array(&HFF&, &H40FF&, &H80FF&, &HB0FF&, &HFF00&, &HFF40&, &HFF80&, &HFFB0&, &HFF0000, &HFF4000, &HFF8000, &HFFB000)(Month(DateAdd("m", 1, d)) - 1) (???) 2015/02/25(水) 13:37
お遊びです。 運用としては、回答されたものの方がいいと思います。
新規シートに下記コードを置いて、A1 をダブルクリックすると遊べます。 以降はA列に色をつけると、シートを変更したタイミングで、反映します。
Private Sub Worksheet_Activate() Columns("A").Clear For i = 1 To Worksheets.Count Cells(i, "A").Interior.Color = Worksheets(i).Tab.Color Next End Sub
Private Sub Worksheet_Deactivate() If Range("A1").Interior.Pattern = xlNone Then Exit Sub For i = 1 To Worksheets.Count Worksheets(i).Tab.Color = Cells(i, "A").Interior.Color Next End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim cl If Target.Address = "$A$1" Then For i = 1 To Worksheets.Count cl = RGB(Int(256 * Rnd()), Int(256 * Rnd()), Int(256 * Rnd())) Worksheets(i).Tab.Color = cl Cells(i, "A").Interior.Color = cl Next Cancel = True End If End Sub (Mook) 2015/02/25(水) 14:05
Mookさん
おもしろいですね
何かお遊びbookに利用させていただきます。
質問完了と致します。
回答者の皆様ありがとうございました。
(nobu) 2015/02/25(水) 18:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.