[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『指定数字分だけ行をコピーし、かつ連番(年月)を振りたい』(ショコラ)
初めまして
お力貸してください
次のような表があります
A社名
B月額金額
C契約年
D契約月
E契約期間
A B C D E
AA社 15000 2018 12月 12
BB社 10000 2019 1月 12
CC社 12000 2019 3月 6
DD社 8000 2019 5月 12
Eにある契約期間分だけデータをコピーしたく、以下のような記述をしそれは実現できました。
ーーーーーーーー
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
For j = 1 To sh1.Cells(i, "E")
sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "E")).Copy _
sh2.Cells(k, "A")
k = k + 1
Next j
Next i
End Sub
ーーーーーーーー
同時にC列とD列を組み合わせた年月もその期間分追加したいのですが、そのようなことはそもそも可能なのでしょうか?
(1行目であれば、2018 12月から2019 11月までの表示をしたい)
< 使用 Excel:Office365、使用 OS:MacOSX >
手っ取り早いのが、作業列に条件に合致したかを判定させる数式を書き込んで それをオートフィルタで抽出するだと思います。 マクロで判定させる事が出来るかの判断は必要なし。 (BJ) 2019/03/01(金) 17:55
A B C D E AA社 15000 2018 12月 2 BB社 10000 2019 1月 3
(マナ) 2019/03/01(金) 18:09
Macで Deteadd/MonthName 関数が 使用できるか不明ですが
Sub test() Dim a, b, i As Long, ii As Long, iii As Long, n As Long, myDate As Date a = Sheets("sheet1").Cells(1).CurrentRegion.Value ReDim b(1 To Application.Sum(Application.Index(a, 0, 5)), 1 To UBound(a, 2)) For i = 2 To UBound(a, 1) For ii = 0 To a(i, 5) - 1 n = n + 1 myDate = DateSerial(a(i, 3), Val(a(i, 4)), 1) For iii = 1 To UBound(a, 2) b(n, iii) = a(i, iii) Next b(n, 3) = Year(DateAdd("m", ii, myDate)) b(n, 4) = MonthName(Month(DateAdd("m", ii, myDate))) Next Next With Sheets("sheet2").Cells(1).Resize(, UBound(a, 2)) .CurrentRegion.ClearContents .Value = a .Rows(2).Resize(n).Value = b End With End Sub (seiya) 2019/03/01(金) 18:12
Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("sheet1") Set sh2 = Worksheets("sheet2") Dim i As Long Dim d As Long Dim k As Long Dim m As Long Dim y As Long d = sh1.Range("A65536").End(xlUp).Row k = 1 For i = 1 To d m = Val(sh1.Cells(i, "D")): y = 0
For j = 1 To sh1.Cells(i, "E") sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "E")).Copy _ sh2.Cells(k, "A") sh2.Cells(k, "D") = ((m - 1) Mod 12) + 1 & "月" m = m + 1 sh2.Cells(k, "C") = Val(sh2.Cells(k, "C")) + y If sh2.Cells(k, "D") = "12月" Then y = y + 1 k = k + 1 Next j Next i End Sub (mm) 2019/03/01(金) 18:14
Sub test() Dim a, b, i As Long, ii As Long, iii As Long, n As Long, myDate As Date a = Sheets("sheet1").Cells(1).CurrentRegion.Value ReDim b(1 To Application.Sum(Application.Index(a, 0, 5)), 1 To UBound(a, 2)) For i = 2 To UBound(a, 1) For ii = 0 To a(i, 5) - 1 n = n + 1 myDate = DateSerial(a(i, 3), Val(a(i, 4)), 1) For iii = 1 To UBound(a, 2) b(n, iii) = a(i, iii) Next b(n, 3) = Year(DateAdd("m", ii, myDate)) b(n, 4) = MonthName(Month(DateAdd("m", ii, myDate))) Next Next With Sheets("sheet2").Cells(1).Resize(, UBound(a, 2)) .CurrentRegion.ClearContents .Value = a .Rows(2).Resize(n).Value = b End With End Sub
皆様ありがとうございます
(ショコラ) 2019/03/20(水) 17:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.