|
▼ロシツキー さん:
ごめんなさい。仕様を勘違いしていたようです。
> A 1
> B 1
> C 0
> D 1
> E 5
>
>
>タイトル>
>ここに貼り付けていきます
ということなんですね?
単純化して、 A列のデータだけ 指定の行数だけ
【別のセル範囲】にコピーする例を示します。
配列を使っています。
Sub Try2()
Dim a, b() As String
Dim CopyTimes, max As Long
Dim i As Long, j As Long, k As Long
Dim n As Long
CopyTimes = Range("CopyTimes").Value
max = WorksheetFunction.max(Range("CopyTimes").Columns(2))
a = Range("A1").CurrentRegion.Resize(, 1).Value
ReDim b(1 To UBound(a) * max, 1 To 1)
n = 1
b(n, 1) = a(1, 1) '--- タイトルのコピー
For i = 2 To UBound(a)
For j = 1 To UBound(CopyTimes)
If InStr(a(i, 1), CopyTimes(j, 1)) Then
'--------- 配列内で指定回数 Copy
For k = 1 To CopyTimes(j, 2)
n = n + 1 '配列内位置カウンタ
b(n, 1) = a(i, 1)
Next
Exit For
End If
Next
Next
'------------ 配列(n行)を指定セルに貼付け
Range("A20").Resize(n, 1).Value = b
End Sub
|
|