ID非公開

2020/11/14 19:26

44回答

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

画像
補足

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

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

ベストアンサー

0

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

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

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

その他の回答(3件)

0

数式を使用して、該当データを取り出した後、「値」に変換しています。 コピペを繰り返さないので高速で終わります。 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

以下でどうなりますか 標準モジュールに以下を記述して、Samp1 を実行してみます ※ 今後変更があるのか分かりませんが、少ない修正量で・・・ もし、5行単位が変更になるのなら、以下部分の変更で >   Const CRH As Long = 5 ' 転記単位行数 もし、Sheet2 列方向展開数に変更あるのなら、以下部分の変更で >   Const CCC As Long = 2 ' 列方向展開数 もし、A,B 2列でなく、A,B,C 3列でやりたいのなら >      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

Sub a() '2例です 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