ID非公開

2020/11/14 19:26

44回答

Excel VBAの質問があります。 Sheet1のA列（番号）とB列（名前）があります。 Sheet1のデータを５つ区切りでB列に転記したいです。

Excel VBAの質問があります。 Sheet1のA列（番号）とB列（名前）があります。 Sheet1のデータを５つ区切りでB列に転記したいです。 ※Sheet1の数値は可変します。 シート１の１～５は、シート２のA1:B6 シート１の６～１０は、シート２のC1:D6 シート１の１０～１５は、シート２のA７:B１２ シート１の１６～２０は、シート２のC７:D１２ とういう感じで、シート１のデータ数に合わせて同じような処理がしたいです。

画像
補足

誤：Sheet1のデータを５つ区切りで『B列』に転記したいです。 正：Sheet1のデータを５つ区切りで、『Sheet2』に転記したいです。

Excel | Visual Basic・120閲覧・xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0

tra********

カテゴリマスター

2020/11/14 21:37

一例です。 Sub sample() Dim sh2 As Worksheet, rng0 As Range Dim i As Long, j As Long, jj As Long Application.ScreenUpdating = False Set sh2 = Worksheets("シート２") j = -5 jj = 3 With Worksheets("シート１") Set rng0 = .Range("A1:B1") For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 5 If jj > 1 Then jj = 1 j = j + 6 Else jj = jj + 2 End If Union(rng0, .Cells(i, 1).Resize(5, 2)).Copy sh2.Cells(j, jj) Next i End With Application.ScreenUpdating = True End Sub

ThanksImg質問者からのお礼コメント

初心者に１番分かりやすかったです。 ありがとうございます。 ちなみに、ＶＢＡ歴は何年くらですか？ ※このレベルに到達するまでどのくらいの年数を要するのか気になりました。 とても参考になりました。

お礼日時：2020/11/16 13:57

その他の回答（3件）

0

ask********

2020/11/15 13:25（編集あり）

数式を使用して、該当データを取り出した後、「値」に変換しています。 コピペを繰り返さないので高速で終わります。 Sub sample02() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim j As Long Dim n As Long Dim ii As Long Dim st As String Set ws1 = Worksheets("sheet1") Set ws2 = Worksheets("sheet2") ws2.Range("a:d").Clear st = "=IF(MOD(ROW(A6),6)=0,INDEX({""番号"",""名前""}," st = st & "IF(ISODD(COLUMN()),1,2))," st = st & "INDEX(\\!$A:$B,ROW()+(FLOOR(ROW(A6),6)/6-1)*4" st = st & "+(COLUMN()>=3)*5,IF(ISODD(COLUMN()),1,2)))" st = Replace(st, "\\", ws1.Name) j = ws1.Cells(Rows.Count, 1).End(xlUp).Row - 1 n = WorksheetFunction.RoundDown(j / 10, 0) ii = Application.Min(5, j Mod 10) If ii > 0 Then ii = ii + 1 With ws2.Range("a1:b1").Resize(n * 6 + ii) .Formula = st .Value = .Value End With ii = j Mod 10 If ii > 5 Then ii = ii Mod 5 + 1 Else ii = 0 End If With ws2.Range("c1:d1").Resize(n * 6 + ii) .Formula = st .Value = .Value End With End Sub

ID非公開

質問者

2020/11/16 13:55

とても、難しいコードで理解が追い付いていません。。 これかの勉強の参考にさせていただきます。 レベル的には一番すごいと思いますが、初心者が分かりやすいコードをベストアンサーに選びたいと思います。

0

30246kiku

2020/11/15 5:54

以下でどうなりますか 標準モジュールに以下を記述して、Samp1 を実行してみます ※ 今後変更があるのか分かりませんが、少ない修正量で･･･ もし、５行単位が変更になるのなら、以下部分の変更で >   Const CRH As Long = 5 ' 転記単位行数 もし、Sheet2 列方向展開数に変更あるのなら、以下部分の変更で >   Const CCC As Long = 2 ' 列方向展開数 もし、A,B ２列でなく、A,B,C ３列でやりたいのなら >      With .Range("B1", .Cells(Rows.Count, "A").End(xlUp)) ↓       With .Range("C1", .Cells(Rows.Count, "A").End(xlUp)) どうなりますか Option Explicit Public Sub Samp1()    Dim rng As Range    Dim i As Long, j As Long, k As Long    Const CRH As Long = 5 ' 転記単位行数    Const CCC As Long = 2 ' 列方向展開数    Set rng = Worksheets("Sheet2").Range("A1")    Application.ScreenUpdating = False    With Worksheets("Sheet1")       With .Range("B1", .Cells(Rows.Count, "A").End(xlUp))          j = .Columns.Count '         Range(rng, rng.End(xlDown)).Resize(, j * CCC).Clear          k = 0          For i = 2 To .Rows.Count Step CRH             Union(.Rows(1), .Rows(i).Resize(CRH)) _                .Copy rng.Offset(, j * k)             k = k + 1             If (k >= CCC) Then                k = 0                Set rng = rng.Offset(CRH + 1)             End If          Next       End With    End With    Application.ScreenUpdating = True End Sub

0

PSX

2020/11/15 0:39

Sub a() '２例です Dim i As Long Dim myNum As Long Dim myRng As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Application.ScreenUpdating = False Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws2.Select For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row Step 5 Select Case myNum Mod 2 Case 0: Set myRng = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0) Case 1: Set myRng = ws2.Cells(Rows.Count, 3).End(xlUp).Offset(2, 0) End Select ws1.Cells(i, 1).Resize(5, 2).Copy Destination:=myRng myRng.Offset(-1, 0).Resize(1, 2).Value = Split("番号,名前", ",") myNum = myNum + 1 Next i ws2.Rows(1).Delete Application.ScreenUpdating = True End Sub