| |
▼マナ さん：
▼マナさん
ご教示頂いた順序でマクロを書いてみました。
・最後に並べ替えをする際に、コードが被る事があるので、C列に並べ替え用Noを入れる項目を追加。
・並べ替えの書き方がわからなかったので、記録して範囲を最終行までに変更。
→省けるコードなどがわからなかったので、そのままコピペしてしまった。
もっとシンプルに書く方法などがありますか？
・データの量を増やして何度かテストしたのですが、
なぜか、データの項目名から取ってきてしまう場合が5回に1回くらい起こってしまった。→未解決
書いたコードは以下の通りです。
添削とアドバイスがありましたらご教示頂きたく、よろしくお願いします。
Sub tenki()
Dim k As Long, g As Long 'k=期間 g=繰り返し用
Dim MaxRow1 As Long
Dim kaishi As Date '開始日
Dim shuryo As Date '終了日
Dim h As Date '日付入力用
'変数"k"に期間(何か月)をセット
k = Sheet1.Range("B5")
kaishi = Sheet1.Range("B6")
shuryo = Sheet1.Range("B7")
For g = 1 To k
'sheet1のデータをsheet2に貼り付け
If Sheet2.Range("C6") = "" Then
MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
Sheet2.Range("C6").PasteSpecial
MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
Else
MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
Sheet2.Range("C" & MaxRow1 & "").PasteSpecial
MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
End If
'日付の入力
h = DateSerial(Year(kaishi), Month(kaishi) + g, 0)
Sheet2.Range("D" & MaxRow1 & ":D" & MaxRow2 & "").Formula = h
Next
'並べ替え
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C6:C" & MaxRow2 & "") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("D6:D" & MaxRow2 & "") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("C5:K" & MaxRow2 & "")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
