[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じ文字列を複数回繰り返すには』(ブルー☆ギラヴァンツ)
いつもお世話になっております
りんご
バナナ
スイカ
となっている列を
りんご
りんご
りんご
バナナ
バナナ
バナナ
スイカ
スイカ
スイカ
みたいに複数回繰り返すにはどうすればよろしいでしょうか
見本では3回ですが任意の回数繰り返す方法も教えてくださいよろしくお願いします
< 使用 Excel:Excel2019、使用 OS:Windows10 >
Option Explicit Sub OneInstanceMain() Dim i As Long Dim j As Long Dim x As Long Dim n As Long Dim sNm As String Dim v() As Variant Dim w() As Variant x = 3 With Worksheets("Sheet1") v = .Cells(1).CurrentRegion.Value .Copy after:=Worksheets(1) sNm = ActiveSheet.Name End With ReDim w(1 To x * UBound(v, 1), 1 To 1) For i = 1 To UBound(v, 1) For j = 1 To x n = n + 1 w(n, 1) = v(i, 1) Next Next With Worksheets(sNm) .UsedRange.Clear .Cells(1).Resize(UBound(w, 1), UBound(w, 2)) = w End With Erase v, w End Sub こんな感じでせうか。^^; >>任意の回数繰り返す方法 何らかの方法で反復回数をプロシジャーに受け取らせ、変数 xに格納してください。m(__)m (隠居Z) 2023/01/25(水) 23:12:16
お遊び InputBoxに数値以外、キャンセル、×で閉じるを行うとエラーになります。 '■Evaluate計算式Ver Sub test() Dim v As Variant Dim f As String Dim ws As Worksheet Dim rptNum As Long Set ws = Sheets("Sheet1") rptNum = InputBox("繰り返し回数", , 2) ws.Activate f = "TRANSPOSE(IF(ROW(1:■),REPT(A1:A■&"","",▲)))" f = Replace(f, "■", ws.Cells(Rows.Count, "A").End(xlUp).Row) f = Replace(f, "▲", rptNum) v = Evaluate(f) v = Join(v, "") v = Split(Left(v, Len(v) - 1), ",") With Sheets.Add(after:=Sheets(Sheets.Count)) .[A1].Resize(UBound(v)).Value = Application.Transpose(v) End With MsgBox "新しいシートに出力しました" End Sub
'■ByRef渡し、再帰処理Ver Sub test2() Dim ws As Worksheet Dim r As Range Dim rptNum As Long Set ws = Sheets("Sheet1") rptNum = InputBox("繰り返し回数", , 2) ReDim v(0 To 0) For Each r In ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp)) Call 文字繰り返し(v, r.Value, rptNum) Next r With Sheets.Add(after:=Sheets(Sheets.Count)) .[A1].Resize(UBound(v)).Value = Application.Transpose(v) End With MsgBox "新しいシートに出力しました" End Sub Sub 文字繰り返し(ByRef v As Variant, ByVal moji As String, ByVal reptNum As Long, Optional cnt As Long = 1) ReDim Preserve v(1 To UBound(v) + 1) v(UBound(v)) = moji If reptNum > cnt Then Call 文字繰り返し(v, moji, reptNum, cnt + 1) End If End Sub
(稲葉) 2023/01/26(木) 08:35:54
他の列に: =IFERROR(INDEX($A$1:$A$3,INT((ROW(A1)-1)/3)+1),"")
必要数、下にコピーします。
>任意の回数繰り返す方法(5回にするなら)
INT((ROW(A1)-1)/3)+1 → INT((ROW(A1)-1)/5)+1
(メジロ) 2023/01/26(木) 08:53:55
1. 行をコピーする 2. 指定数-1行分、コピーした行を挿入する
という処理を繰り返しても良さそうにおもいます。
この方法であれば、繰り返し部分を除き【マクロの記録】で必要な命令を調べることができるとおもいます。
よって、まずは3行目のスイカをコピーして、3〜4行目に挿入する作業を【マクロの記録】でコード化してどのような命令が使われているか確認してみてはどうでしょうか?
(もこな2) 2023/01/26(木) 09:08:19
Sub Sample() Dim xl As Application Dim rng As Range Dim cnt As Long Dim i As Long Set xl = Excel.Application On Error Resume Next Set rng = xl.InputBox("複写元範囲を選択してください", Type:=8) If rng Is Nothing Then Exit Sub cnt = xl.InputBox("何回繰り返しますか?", Type:=1) cnt = cnt - 1 If cnt < 1 Then Exit Sub On Error GoTo 0 With rng xl.ScreenUpdating = False For i = .Rows.Count To 1 Step -1 With .Rows(i) .Offset(1).Resize(cnt).Insert .Copy .Offset(1).Resize(cnt) End With Next xl.CutCopyMode = False xl.ScreenUpdating = True End With End Sub
(こんな感じかな) 2023/01/26(木) 11:02:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.