Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

978 / 76735

←次へ　｜　前へ→


	【81416】Re:表を加工して別ｼｰﾄに転記したい

ありす - 20/7/25(土) 23:47 -


	引用なし

	パスワード

▼マナさん：
▼マナさん
ご教示頂いた順序でマクロを書いてみました。
・最後に並べ替えをする際に、コードが被る事があるので、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

1 hits

▼

【81401】表を加工して別ｼｰﾄに転記したい ありす 20/7/21(火) 15:50