回答(5件)

0

あまり簡単にはならないですが、 Sub test() Dim ws As Worksheet, ws2 As Worksheet Dim i As Integer, j As Integer Set ws = ActiveSheet Set ws2 = ActiveSheet.Next j = 0 For i = 3 To 10 j = j + 1 ws2.Range("o" & j & ":p" & j) = ws.Range("n" & i & ":o" & i).Value j = j + 1 ws2.Range("o" & j & ":p" & j) = ws.Range("n" & i & ":o" & i).Value If i = 4 Then i = 5 Next ws2.Range("o19:p19") = ws.Range("n5:o5").Value ws2.Range("o19:p19").NumberFormat = "-#,##0" End Sub

画像
1

規則性のない転記は愚直な方が後で読みやすく、メンテナンスしやすいので、そのままでも良いと思います。 また、自分の身の回りの自動化においては『開発や修正にかける時間』と『そのマクロによって節約できる時間』の費用対効果は常に意識した方がいいです。 本当に単純な転記の場合、ゼロから書くより、マクロの記録からコードを整形する方が費用対効果は高かったりします。 後の状況変化に備えようと無理して書くと例えば以下のようになると思いますが、手間の割に得られる効果(柔軟性や拡張性)はいまいちかもしれません。 Sub test() '設定変数 Dim InputSheet As Worksheet Dim OutputSheet As Worksheet Dim InputColumn As String Dim OutputColumn As String Dim DataWidth As Integer Dim FromRow As Object Set FromRow = CreateObject("Scripting.Dictionary") '設定変更箇所 Set InputSheet = ActiveSheet Set OutputSheet = ActiveSheet.Next InputColumn = "N" OutputColumn = "O" DataWidth = 2 '転記する列幅 OutputSheet.Cells(19, "O").Resize(, 2).NumberFormat = "-#,##0" '書式設定 With FromRow '出力行と入力行の対応関係 .Add 1, 3 .Add 2, 3 .Add 3, 4 .Add 4, 4 .Add 5, 6 .Add 6, 6 .Add 7, 7 .Add 8, 7 .Add 9, 8 .Add 10, 8 .Add 11, 9 .Add 12, 9 .Add 13, 10 .Add 14, 10 .Add 19, 5 End With '主処理 Dim ToRow As Variant With OutputSheet For Each ToRow In FromRow .Cells(ToRow, OutputColumn).Resize(, DataWidth) _ = InputSheet.Cells(FromRow(ToRow), InputColumn).Resize(, DataWidth) Next ToRow End With '後処理 Set InputSheet = Nothing Set OutputSheet = Nothing Set FromRow = Nothing End Sub

画像

1人がナイス!しています

1

行が覚えきれなくてわけわかんなくなるので配列に入れます。 あとは順番に配列から行番号を取り出せばミスも少ないかと、 Sub test() Dim i As Long, R1(), R2() R1 = Array(3, 3, 4, 4, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 5) R2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 19) With ActiveSheet For i = 0 To UBound(R1) .Next.Cells(R2(i), "O").Resize(, 2) = .Cells(R1(i), "N").Resize(, 2).Value Next i .Next.Cells(19, "O").Resize(, 2).NumberFormat = "-#,##0" End With End Sub

1人がナイス!しています

1

ActiveSheet.NextはActiveSheetが一番右だった場合も考えた方がいい。 Option Explicit Sub MakeItBetter() Dim ws As Worksheet, ws2 As Worksheet Dim cnt As Long, i As Long Application.ScreenUpdating = False Set ws = ActiveSheet Set ws2 = ActiveSheet.Next If ws2 Is Nothing Then MsgBox "次は無し" Exit Sub End If For i = 0 To 13 ws2.Range("O1").Offset(i).Resize(, 2).Value = ws.Range("N3").Offset(cnt).Resize(, 2).Value If i Mod 2 = 1 Then cnt = cnt + 1 If cnt = 2 Then cnt = cnt + 1 End If Next i With ws2.Range("O19:P19") .Value = ws.Range("N5:O5").Value .NumberFormatLocal = "-#,##0" End With Application.ScreenUpdating = True End Sub

1人がナイス!しています

2

無いです。 問題無く動くなら、そのままにしておいた方が無難です。 ループを使うなど、一見すると色々方法は有りそうに見えますが、規則性が低いので、「簡単」に書きなおした結果、かえって読みにくくメンテナンスしにくいコードになります。やりたくなるのは分かりますが、後悔すると思います。 強いて言うなら .Value は省略できます。 あとは、転記元と転記先の組合わせを考慮しながら、セルの範囲に名前を定義しておけばコードの読み書きは楽になります。そこまでやる必要があるとは思えませんが。 <セル範囲と名前の組合わせ> O1:P1 => 転記先1 O2:P2 => 転記先2 O3:P3 => 転記先3 (中略) O14:P14 => 転記先14 ーーーーーーーーー N3:O3 => 転記元1 N4:O4 => 転記元2 N5:O5 => 転記元3 (中略) N10:O10 => 転記元7 <ループするコード> For i = 1 To 7 For ii = 1 To 2 ws2.Range("転記先" & ii) = ws.Range("転記元" & i) Next Next

2人がナイス!しています