[[20240417102548]]　『マクロでB列の数だけA列の値を表示したい』（Ty）　ページの最後に飛ぶ

『マクロでB列の数だけA列の値を表示したい』（Ty）

 マクロでB列の数だけA列の値をE列に連続で表示したい
 ご教示をお願いします

     |[A]   |[B]|[C]|[D]|[E]   
 [1] |東京  |  5|   |   |      
 [2] |大阪  |  3|   |   |      
 [3] |名古屋|  2|   |   |      
 [4] |福岡  |  1|   |   |      
 [5] |札幌  |  3|   |   |      
 [6] |仙台  |  1|   |   |      
 [7] |京都  |  2|   |   |      
 [8] |      |   |   |   |      
 [9] |      |   |   |   |東京  
 [10]|      |   |   |   |東京  
 [11]|      |   |   |   |東京  
 [12]|      |   |   |   |東京  
 [13]|      |   |   |   |東京  
 [14]|      |   |   |   |大阪  
 [15]|      |   |   |   |大阪  
 [16]|      |   |   |   |大阪  
 [17]|      |   |   |   |名古屋
 [18]|      |   |   |   |名古屋
 [19]|      |   |   |   |福岡  
 [20]|      |   |   |   |札幌  
 [21]|      |   |   |   |札幌  
 [22]|      |   |   |   |札幌  
 [23]|      |   |   |   |仙台  
 [24]|      |   |   |   |京都

＜使用 Excel：Excel2019、使用 OS：Windows11 ＞

訂正
B7は　1 です
（Ty） 2024/04/17(水) 10:32:41

E列の開始行はどこ？ A列の最終行+2行目？

（POI） 2024/04/17(水) 10:38:51

 はい　そうです
 よろしくお願いします
（Ty） 2024/04/17(水) 10:44:49

 これではどうですか？

 Sub Sample()
    Dim lastrow As Long, i As Long, r As Long

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    r = lastrow + 2
    For i = 1 To lastrow
        Range(Cells(r, "E"), Cells(r + Cells(i, "B") - 1, "E")) = Cells(i, "A")
        r = r + Cells(i, "B")
    Next i
 End Sub
（通行人） 2024/04/17(水) 11:09:51

ありがとうございました
できました
（Ty） 2024/04/17(水) 11:20:13

 あとだし質問ですみません

 1、福岡を0とした時　マクロを実行すると「名古屋」が1個で「福岡」が1個表示されますが
 「名古屋」は2個表示とし、「福岡」は表示なしとしたいのですが
 方法はありますでしょうか

 2、対象範囲は　A1:B7 のみとし
 lastrow = Cells(Rows.Count, "A").End(xlUp).Row　を使用しない方法はありますでしょうか
 (A列とB列の下方の行で使用済みのセルがあるので・・)

 3、E列の開始行は　E9　に固定する方法もお教えください

（Ty） 2024/04/17(水) 15:10:29

 1、B列の値が 0よりも大きい場合に、地名の書込みと rの更新をすれば良いでしょう。
 2、lastrow = 7 固定にすれば良いでしょう。
 3、r = 9 から処理を始めれば良いでしょう。
（通行人） 2024/04/17(水) 15:43:08

ありがとうございました
できました
（Ty） 2024/04/17(水) 16:04:13

解決筋のようですが、コメントしておきます。
何個分書き込めばいいかわかっているので、Resizeを使って

    Sub 別案1()
        Dim 貼付先 As Range
        Dim MyRNG As Range

        Set 貼付先 = Range("E9")

        For Each MyRNG In Range("A1:A7")
            If MyRNG.Offset(, 1).Value > 0 Then
                MyRNG.Copy 貼付先.Resize(MyRNG.Offset(, 1).Value)
                Set 貼付先 = Cells(Rows.Count, "E").End(xlUp).Offset(1)
            End If
        Next MyRNG
    End Sub

とか

    Sub 別案2()
        Dim 出力先 As Range
        Dim MyRNG As Range

        Set 出力先 = Range("E9")

        For Each MyRNG In Range("A1:A7")
            If MyRNG.Offset(, 1).Value > 0 Then
                出力先.Resize(MyRNG.Offset(, 1).Value).Value = MyRNG.Value
                Set 出力先 = Cells(Rows.Count, "E").End(xlUp).Offset(1)
            End If
        Next MyRNG
    End Sub

とかでもよさそうに思いました。参考まで。

（もこな２） 2024/04/17(水) 20:44:54

 もこな２様
 回答ありがとうございます
（Ty） 2024/04/18(木) 17:37:30

コメント返信：

[ 一覧(最新更新順) ]

[[20240417102548]] 『マクロでB列の数だけA列の値を表示したい』（Ty） ページの最後に飛ぶ

[[20240417102548]]　『マクロでB列の数だけA列の値を表示したい』（Ty）　ページの最後に飛ぶ