[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『年度でなくて日付を転記するには』(さんま)
下記のVBAはセルB列に年度の数字を入れている場合のVBAになります。
それをB列に日付(例:2015/4/18)を入れて同じように年度ごとに分けられるよう作動させるにはどこを直したらよいのでしょうか?
Sub 日付転記()
Dim a, x, i As Long, ii As Long, n As Long, temp, txt Dim minYear As Long, maxYear As Long With Cells(1).CurrentRegion a = .Value: n = 1 minYear = Application.Min(.Columns(2)) maxYear = Application.Max(.Columns(2)) ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + maxYear - minYear + 2) For i = 2 To UBound(a, 2) - 1 a(n, i) = minYear + i - 2 & "年" Next a(n, UBound(a, 2)) = "番号" With CreateObject("Scripting.Dictionary") .CompareMOde = 1 For i = 2 To UBound(a, 1) If Not .exists(a(i, 1)) Then n = n + 1: .Item(a(i, 1)) = n: a(n, 1) = a(i, 1) End If temp = a(i, 2): a(i, 2) = "" txt = a(i, 3): a(i, 3) = "" a(.Item(a(i, 1)), temp - minYear + 2) = temp a(.Item(a(i, 1)), UBound(a, 2)) = txt Next End With With .Offset(, .Columns.Count + 1).Cells(1).Resize(n, UBound(a, 2)) .CurrentRegion.ClearContents .Value = a .Columns.AutoFit End With End With End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
1.年度初めは、いつなんですか?
※世間一般では、1月1日か、4月1日にする人が多いとは思いますけど。
2.B列は全部日付になるんですか? それとも一部のデータは年度のままなんですか?
(半平太) 2015/05/22(金) 15:41
2.B列は全て日付にします。
宜しくお願い致します。
(さんま) 2015/05/22(金) 15:51
横から失礼します。
Sub 日付転記() Dim a, x, i As Long, ii As Long, n As Long, temp, txt Dim minYear As Long, maxYear As Long With Cells(1).CurrentRegion a = CvYear(.Value): n = 1 minYear = Application.Min(a) maxYear = Application.Max(a) ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + maxYear - minYear + 2) For i = 2 To UBound(a, 2) - 1 a(n, i) = minYear + i - 2 & "年" Next a(n, UBound(a, 2)) = "番号" With CreateObject("Scripting.Dictionary") .CompareMOde = 1 For i = 2 To UBound(a, 1) If Not .exists(a(i, 1)) Then n = n + 1: .Item(a(i, 1)) = n: a(n, 1) = a(i, 1) End If temp = a(i, 2): a(i, 2) = "" txt = a(i, 3): a(i, 3) = "" a(.Item(a(i, 1)), temp - minYear + 2) = temp a(.Item(a(i, 1)), UBound(a, 2)) = txt Next End With With .Offset(, .Columns.Count + 1).Cells(1).Resize(n, UBound(a, 2)) .CurrentRegion.ClearContents .Value = a .Columns.AutoFit End With End With End Sub
Function CvYear(Dts) Dim x, y, cv() For x = 1 To UBound(Dts) For y = 1 To 2 If IsDate(Dts(x, y)) Then Dts(x, y) = Year(DateAdd("m", -3, Dts(x, y))) Next y Next x CvYear = Dts End Function
日付から年度に変換するユーザー定義関数を作成しています。 B列はどちらでもいいようにしてあります。
(ろっくん) 2015/05/22(金) 16:12
※今までの処理は正しかった、と云う前提です。 ※既存の処理の細部はチェックしておりません m(__)m
aに格納されている日付データを最初から年度に変換してしまう案です。
> minYear = Application.Min(.Columns(2)) > maxYear = Application.Max(.Columns(2))
↓上記2文を下記9文に変更
minYear = CLng(Format(Application.Min(.Columns(2)) + 275, "YYYY")) - 1 maxYear = CLng(Format(Application.Max(.Columns(2)) + 275, "YYYY")) - 1
If minYear < 1970 Then MsgBox "日付データが古すぎませんか?" Exit Sub End If
For i = 2 To UBound(a) ’日付を年度(4月1日始め)に変換 a(i, 2) = CLng(Format(a(i, 2) + 275, "YYYY")) - 1 Next i
(半平太) 2015/05/22(金) 16:44
転記はできましたが、西暦だけでなく月と日にちも転記したいのです。
2015/5/22←のように転記したいです。
↑を2015年の列に明記したいです。
宜しくお願い致します。
(さんま) 2015/05/22(金) 18:35
あれ? 今までと同じものを作るんじゃないのですかぁ。
・・・とすると何を作ればいいのかよく分かりません。
※ご提示のプログラムをつぶさに読んだら分かるのかも知れませんが、 現在、その気力が涌かないので、私は、ここでドロップアウトさせて頂きます。 大変申し訳ありません。 m(__)m
(半平太) 2015/05/22(金) 20:17
With Cells(1).CurrentRegion a = .Value: n = 1 ↓ Dim b() With Cells(1).CurrentRegion a = .Value: n = 1 ReDim b(1 To UBound(a, 1))
さらに
a(.Item(a(i, 1)), temp - minYear + 2) = temp ↓ a(.Item(a(i, 1)), temp - minYear + 2) = b(i)
(マナ) 2015/05/22(金) 21:04
For i = 2 To UBound(a) ’日付を年度(4月1日始め)に変換 a(i, 2) = CLng(Format(a(i, 2) + 275, "YYYY")) - 1 Next i ↓ For i = 2 To UBound(a) ’日付を年度(4月1日始め)に変換 b(i) = a(i, 2) a(i, 2) = CLng(Format(a(i, 2) + 275, "YYYY")) - 1 Next i
(マナ) 2015/05/22(金) 21:25
(さんま) 2015/05/26(火) 18:13
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.