Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2019)
数値の繰り返しに附いて教えてください
投稿日時: 22/07/27 13:06:37
投稿者: あはんです

	A	   B	   C   	D
1	コード	   回数		結果
2	123456789123 	5		123456789123 
3	987654321456 	2		123456789123 
4	456123987123 	3		123456789123 
5	456321987789 	5		123456789123 
6	↑	    ↑		123456789123 
7	12桁の数値です	1万未満です	987654321456 
8	さまざまな数値です		987654321456 
9				    456123987123 
10				    456123987123 
11				    456123987123 
12				    456321987789 
13				    456321987789 
14				    456321987789 
15				    456321987789 
16				    456321987789 

 
プログラムを書くことができません。
 
A列のコードをB列の回数によってD列の結果に代入されていきます。

わかっていること(イメージができること)は
@ 1回目はcells(2,4)=cells(2,1)からはじまる
A do until空欄まで 〜loopを使うこと
B i=i+1 や activecell.offset(1,0)を使うこと
 
わかっていないこと
@ B列の回数の数値をプログラムへの表現方法ができません
A これらのif文が表現がてきていません
 
すみませんが、宜しくお願い申し上げます

回答
投稿日時: 22/07/27 14:07:24
投稿者: simple

繰り返しの回数が決まっている場合は、For ... Next の使用を推奨します。
こんなコード例は参考になりますか?
 

Sub test()
    Dim j As Long
    Dim k As Long
    Dim row_start As Long
    Dim n_repeat As Long
    Dim v As Double
    
    Columns("D:D").NumberFormatLocal = "0"

    row_start = 2
    For j = 2 To 5      '例示です。本来は、Endを使った最終行判定が望ましい
        v = Cells(j, "A").Value
        n_repeat = Cells(j, "B").Value
        
        For k = 1 To n_repeat
            Cells(row_start + (k - 1), "D").Value = v
        Next
        row_start = row_start + n_repeat
    Next
End Sub

# 途中まででもご自分のコードを示して意見を求めたほうが学習効果は上がります。

回答
投稿日時: 22/07/27 15:00:11
投稿者: sk

引用:
A列のコードをB列の回数によってD列の結果に代入されていきます。

(標準モジュール)
----------------------------------------------------------------------
Sub Test1()
 
    Dim wsSource As Worksheet
    Dim lngSourceColumn As Long
    Dim lngSourceFirstRow As Long
    Dim lngSourceLastRow As Long
     
    '複写元シートの参照。ここではアクティブシートとする
    Set wsSource = ActiveSheet
     
    With wsSource
         
        '複写元となる列の番号
        lngSourceColumn = 1
        'その列の最初のデータ行の番号
        lngSourceFirstRow = 2
        'その列の最後のデータ行の番号を取得
        lngSourceLastRow = .Cells(.Rows.Count, lngSourceColumn).End(xlUp).Row
             
        'データ行がなければ終了
        If lngSourceLastRow < lngSourceFirstRow Then
            Set wsSource = Nothing
            Exit Sub
        End If
     
    End With
     
    Dim wsDestination As Worksheet
    Dim lngDestinationColumn As Long
    Dim lngDestinationFirstRow As Long
    Dim lngDestinationLastRow As Long
     
    '複写先シートの参照。ここでは複写元シートと同じシートにする
    Set wsDestination = wsSource
     
    With wsDestination
         
        '複写先となる列の番号
        lngDestinationColumn = 4
        'その列の最初のデータ行の番号
        lngDestinationFirstRow = 2
        'その列の最後のデータ行の番号を取得
        lngDestinationLastRow = .Cells(.Rows.Count, lngDestinationColumn).End(xlUp).Row
         
        '既に1件以上のデータ行が複写先の列に存在する場合
        If lngDestinationLastRow >= lngDestinationFirstRow Then
            'それらのセル範囲の値/数式をクリアする
            .Range(.Cells(lngDestinationFirstRow, lngDestinationColumn), _
                   .Cells(lngDestinationLastRow, lngDestinationColumn)).ClearComments
        End If
         
    End With
         
    Dim rngSourceCell As Range
    Dim lngSourceRow As Long
    Dim rngDestinationCell As Range
    Dim lngDestinationRow As Long
    Dim lngCopyCount As Long
    Dim lngRepeat As Long
         
    '複写先となるセルの行番号の初期値を設定
    lngDestinationRow = lngDestinationFirstRow
     
    '複写元の最初の行から最後の行まで繰り返す
    For lngSourceRow = lngSourceFirstRow To lngSourceLastRow
         
        '複写元セルの参照
        Set rngSourceCell = wsSource.Cells(lngSourceRow, lngSourceColumn)
         
        '複写元セルの1つ右のセルに、数値データに変換できる値が格納されている場合
        If IsNumeric(rngSourceCell.Offset(0, 1).Value) Then
            '複写回数の取得
            lngCopyCount = CLng(rngSourceCell.Offset(0, 1).Value)
        '数値データに変換できない値が格納されている場合
        Else
            '複写回数を0にする
            lngCopyCount = 0
        End If
         
        '複写回数の分だけループする(複写回数が0以下ならループしない)
        For lngRepeat = 1 To lngCopyCount
             
            '複写先セルの参照
            Set rngDestinationCell = wsDestination.Cells(lngDestinationRow, lngDestinationColumn)
            '複写先セルの表示形式を複写元セルと同じ形式にする
            rngDestinationCell.NumberFormat = rngSourceCell.NumberFormat
            '複写先セルに複写元セルの値を代入する
            rngDestinationCell.Value = rngSourceCell.Value
            Set rngDestinationCell = Nothing
             
            '次の複写先は 1 つ下のセルにする
            lngDestinationRow = lngDestinationRow + 1
        Next
         
        Set rngSourceCell = Nothing
     
    Next
     
    Set wsSource = Nothing
    Set wsDestination = Nothing
 
End Sub
----------------------------------------------------------------------
 
以上のようなコードを実行できればよい、ということでしょうか。

回答
投稿日時: 22/07/27 15:39:56
投稿者: simple

この場合は、二重ループにする必要もないでしょうね。

Sub test2()
    Dim j As Long
    Dim row_start As Long
    Dim n_repeat As Long
    Dim v As Double
    
    Columns("D:D").NumberFormatLocal = "0"

    row_start = 2
    For j = 2 To 5      '例示です。本来は、Endを使った最終行判定が望ましい
        v = Cells(j, "A").Value
        n_repeat = Cells(j, "B").Value
        
        Cells(row_start, "D").Resize(n_repeat).Value = v
        row_start = row_start + n_repeat
    Next
End Sub
参考にしてください。

回答
投稿日時: 22/07/27 15:58:25
投稿者: simple

また、もし多数行の作業で速度が気になるなら、
配列を作成して、それを最後に、シートに一括して書き込むようにすると、
速度向上が見込めます。

投稿日時: 22/07/27 18:28:48
投稿者: あはんです

simple さんの引用:
繰り返しの回数が決まっている場合は、For ... Next の使用を推奨します。
こんなコード例は参考になりますか?
 
Sub test()
    Dim j As Long
    Dim k As Long
    Dim row_start As Long
    Dim n_repeat As Long
    Dim v As Double
    
    Columns("D:D").NumberFormatLocal = "0"

    row_start = 2
    For j = 2 To 5      '例示です。本来は、Endを使った最終行判定が望ましい
        v = Cells(j, "A").Value
        n_repeat = Cells(j, "B").Value
        
        For k = 1 To n_repeat
            Cells(row_start + (k - 1), "D").Value = v
        Next
        row_start = row_start + n_repeat
    Next
End Sub

# 途中まででもご自分のコードを示して意見を求めたほうが学習効果は上がります。

 
本日はありがとうございました。
'例示です。本来は、Endを使った最終行判定が望ましい→5をcells(rows.count,1).end(xlup).rowに変更しました。
nextの後にjを追加しました。
resizeの方法にびっくりしました。大変参考になりました。