[[20180313213649]]　『A列の文字列でB列の数字繰り返し連番を付けて別シ』（ｙｋ）　ページの最後に飛ぶ

『A列の文字列でB列の数字繰り返し連番を付けて別シートに一覧作成』（ｙｋ）

お世話になります。
VBA初心者です。
サンプルを探しながら試行錯誤してるのですが、解決方法がうまく探せませんでした。

【やりたいこと】
●Sheet1----------------
A列　B列
aaa 3
bbb 5

のようなシート（使用する行数は固定ではなく、使用時により変動します）から

●Sheet2（理想の形）-------------------
A列
aaa.jpg
aaa_1.jpg
aaa_2.jpg
bbb.jpg
bbb_1.jpg
bbb_2.jpg
bbb_3.jpg
bbb_4.jpg

という一覧が出せるVBAを作りたいところでした。

Sheet1の
各行B列の数だけ繰り返される形で、
最初は　A列の文字列.jpg、次以降は　_連番.jpg　となる形です。

連番が入らないけどsheet2に行が増やせたサンプル---------------------------
Sub Sample1()
Dim i As Long, wS1 As Worksheet, wS2 As Worksheet

Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

wS2.Range("A:A").ClearContents

On Error Resume Next

For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(wS1.Cells(i, "B")) = wS1.Cells(i, "A") & ".jpg"
Next i

wS2.Range("A1").Delete shift:=xlUp
End Sub

どこを変えたら理想の形になりますでしょうか？
サンプルからの変更でも、全く別のVBAとなっても構いません。
宜しければ、お手数ですがアドバイスいただけると助かります。
よろしくお願いいたしますm(__)m

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

  こんなので、ワークしないですか？

 Sub Sample1()
     Dim i As Long, wS1 As Worksheet, wS2 As Worksheet

     Set wS1 = Worksheets("Sheet1")
     Set wS2 = Worksheets("Sheet2")
     wS2.Range("A:A").ClearContents

     'On Error Resume Next '←無意味に書かない

     For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
         With wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
             .Value = wS1.Cells(i, "A") & "_0.jpg"
             If wS1.Cells(i, "B") > 1 Then
                 .AutoFill Destination:=.Resize(wS1.Cells(i, "B"))
             End If
         End With
     Next i

     wS2.Range("A1").Delete shift:=xlUp
     wS2.Columns("A:A").Replace What:="_0.jpg", Replacement:=".jpg", LookAt:=xlPart
 End Sub

（半平太） 2018/03/13(火) 22:24

 ちょっと書いてみました。
Option Explicit
Sub Sample1()
Dim wS1 As Worksheet, wS2 As Worksheet
Dim MyA As Variant
Dim MyAry() As Variant
Dim i As Long
Dim x As Long
Dim r As Long
Dim k As Long
Dim n As Long
Dim MyFlg As Boolean
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
With wS1
    MyA = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 2).Value
End With
For i = LBound(MyA, 1) To UBound(MyA, 1)
    x = x + Val(MyA(i, UBound(MyA, 2)))
Next
ReDim MyAry(1 To x)
For i = 1 To UBound(MyA, 1)
    k = 1
    MyFlg = False
    For r = 1 To MyA(i, 2)
        n = n + 1
        If MyFlg = False Then
            MyAry(n) = MyA(i, 1) & ".jpg"
            MyFlg = True
        Else
            MyAry(n) = MyA(i, 1) & "_" & k & ".jpg"
            k = k + 1
        End If
    Next
Next
With wS2
    .Range("A:A").ClearContents
    .Range("A1").Resize(UBound(MyAry)).Value = Application.Transpose(MyAry)
End With
Erase MyA, MyAry
End Sub
v(=∩_∩=)v
（SoulMan） 2018/03/13(火) 23:30

半平太様・SoulMan様

ありがとうございます！
どちらのコードもまさに私が目指していた理想の動作になりました。
いろいろな書き方があるんですね

なかなか、自分ではここまで書けないので、とても助かりました。
ありがとうございました！
（ｙｋ） 2018/03/14(水) 01:10

コメント返信：

[ 一覧(最新更新順) ]

[[20180313213649]] 『A列の文字列でB列の数字繰り返し連番を付けて別シ』（ｙｋ） ページの最後に飛ぶ

[[20180313213649]]　『A列の文字列でB列の数字繰り返し連番を付けて別シ』（ｙｋ）　ページの最後に飛ぶ