[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件を検索して行を追加するVBA』(欄)
初めまして。
A3から下へ10行感覚で数字が入力されています。
各10行の中で、数字は5つまでとしたいのですが、6つ以上入力されていた場合、6つ目以降を次の10行へ持っていきたいです。
(例)
A 1 2 3 4 4 5 5 6 6 3 7 1 8 9 9 10 11 12 13 2 14 8 15 7 16 17 18 19 20 21 22 23 10 24 19 25 14
ここでマクロ実行した場合、A8にある数「9」をA13へ持っていき、A13にある「2」以降をA23〜と言うように10行感覚をズラしていきたいです。
どのようなマクロを組めばよいでしょうか。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
Option Explicit
Sub test() Dim i As Long Dim n As Long
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row Step 10 With Cells(i, "A") If .Offset(5).Value <> "" Then .Resize(5).Copy Cells(3, "B").Offset(n) n = n + 10 .Offset(5).Resize(5).Copy Cells(3, "B").Offset(n) Else .Resize(10).Copy Cells(3, "B").Offset(n) End If End With n = n + 10 Next
End Sub
(マナ) 2017/05/12(金) 23:19
Dim r1 As Range, r2 As Range Columns("B:B").Insert Shift:=xlToRight Set r1 = Range("A3:A7") Set r2 = Range("B3:B7") Do r2.Value = r1.Value If r1.Cells(1).Value <> "" Then Set r2 = r2.Offset(10) Set r1 = r1.Offset(5) Loop Until r1.Row > Range("A" & Rows.Count).End(xlUp).Row Columns("A:A").Delete Shift:=xlToLeft End Sub (mm) 2017/05/15(月) 10:03
Dim r1 As Range, r2 As Range, c As Range Columns("B:B").Insert Shift:=xlToRight Set r1 = Range("A3:A7") Set r2 = Range("B3:B7") Do r2.Value = r1.Value For Each c In r1 If c.Value <> "" Then Set r2 = r2.Offset(10): Exit For Next c Set r1 = r1.Offset(5) Loop Until r1.Row > Range("A" & Rows.Count).End(xlUp).Row Columns("A:A").Delete Shift:=xlToLeft End Sub (mm) 2017/05/15(月) 10:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.