[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『列にあるデータを8セルずつ並べたい』（たこ）
データとしては、以下のように並んでいるものになります。
A B C D
このデータを、以下のように並べたいです。
A B C D
------------------------------------
1 2
プレート1 A サンプル1 サンプル9
B サンプル2 サンプル10
C サンプル3 サンプル11
D サンプル4 サンプル12
E サンプル5 サンプル13
F サンプル6
G サンプル7
H サンプル8
Excelはまだ勉強中でして、うまく伝わらなかったら申し訳ありません。
イメージとしては、列のデータを8行ごとに並べる感じなのですが…
お知恵を貸していただけると幸いです。
よろしくお願いいたします。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
Option Explicit
Sub SplitAndCopy()
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim srcRange As Range
Dim destRange As Range
Dim rowCount As Integer
Dim destRow As Integer
Dim destCol As Integer
' ソースシートとデスティネーションシートを指定
Set srcSheet = Worksheets("Sheet1")
Set destSheet = Worksheets("Sheet2")
' ソースデータの範囲を取得
rowCount = srcSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set srcRange = srcSheet.Range("A1:A" & rowCount)
' デスティネーションシートのセルを初期化
destSheet.Cells.ClearContents
' データを8行ごとに区切ってデスティネーションシートにコピー
Dim cell As Range
destRow = 1
destCol = 3
For Each cell In srcRange
destSheet.Cells(destRow, destCol).Value = cell.Value
destRow = destRow + 1
If destRow Mod 9 = 0 Then
destRow = destRow - 7
destCol = destCol + 1
End If
Next cell
'希望のセル構成
Dim i As Long
For i = 2 To 8
destSheet.Cells(i, "B") = srcSheet.Cells(i, "C")
destSheet.Cells(i, "A") = srcSheet.Cells(i, "B")
Next
End Sub
（とりあえず） 2023/07/31(月) 13:35:51
（シャイン） 2023/07/31(月) 13:50:34
プレート２は、A列11行目からになります。
以下のような感じです。
実際のサンプル数は640ありますので、プレート40まで作成します。
A B C D
------------------------------------
1 1 2
2プレート1 A サンプル1 サンプル9
3 B サンプル2 サンプル10
4 C サンプル3 サンプル11
5 D サンプル4 サンプル12
6 E サンプル5 サンプル13
7 F サンプル6 サンプル14
8 G サンプル7 サンプル15
9 H サンプル8 サンプル16
10 1 2
11プレート2 A サンプル17
12 B サンプル18
13 C サンプル19
14 D サンプル20
とりあえず様の返信で8行で区切ることはできました。
（たこ） 2023/07/31(月) 14:17:54
Sub Sample()
Dim Sh As Worksheet
Dim Rng As Range
Dim i As Long
Set Sh = ActiveSheet
Set Rng = Worksheets.Add.Range("A1")
For i = 1 To Sh.Cells(Rows.Count, 1).End(xlUp).Row Step 16
With Rng
.Offset(0, 2).Resize(1, 2).Value = Array(1, 2)
.Offset(1, 0).Value = Sh.Cells(i, 2).Value
.Offset(1, 1).Resize(8, 1).Value = Application.Transpose(Array("A", "B", "C", "D", "E", "F", "G", "H"))
.Offset(1, 2).Resize(8, 1).Value = Sh.Cells(i, 1).Resize(8, 1).Value
.Offset(1, 3).Resize(8, 1).Value = Sh.Cells(i + 8, 1).Resize(8, 1).Value
End With
Set Rng = Rng.Offset(9)
Next
End Sub
（火災報知器） 2023/07/31(月) 15:27:55
先ほどのコードを少し変更するだけです。
（とりあえず） 2023/07/31(月) 15:31:45
A B C D
------------------------------------
1 1 2
2プレート1 A サンプル1 サンプル9
3 B サンプル2 サンプル10
4 C サンプル3 サンプル11
5 D サンプル4 サンプル12
6 E サンプル5 サンプル13
7 F サンプル6
8 G サンプル7
9 H サンプル8
10 1 2
11プレート2 A サンプル14 サンプル22
12 B サンプル15 サンプル23
13 C サンプル16
14 D サンプル17
15 E サンプル18
16 F サンプル19
17 G サンプル20
18 H サンプル21
19 1 2
20プレート3 A サンプル24
21 B サンプル25
22 1 2
23プレート4 A サンプル26
･
･
･
（シャイン） 2023/07/31(月) 16:12:38
当初の表を推理して追加してみた。
|[A] |[B] |[C]|[D]
[1] |サンプル1 |プレート1|A | 1
[2] |サンプル2 |プレート1|B | 1
[3] |サンプル3 |プレート1|C | 1
[4] |サンプル4 |プレート1|D | 1
[5] |サンプル5 |プレート1|E | 1
[6] |サンプル6 |プレート1|F | 1
[7] |サンプル7 |プレート1|G | 1
[8] |サンプル8 |プレート1|H | 1
[9] |サンプル9 |プレート1|A | 2
[10]|サンプル10|プレート1|B | 2
[11]|サンプル11|プレート1|C | 2
[12]|サンプル12|プレート1|D | 2
[13]|サンプル13|プレート1|E | 2
[14]|サンプル14|プレート1|F | 2
[15]|サンプル15|プレート1|G | 2
[16]|サンプル16|プレート1|H | 2
[17]|サンプル17|プレート2|A | 1
[18]|サンプル18|プレート2|B | 1
[19]|サンプル19|プレート2|C | 1
[20]|サンプル20|プレート2|D | 1
[21]|サンプル21|プレート2|E | 1
[22]|サンプル22|プレート2|F | 1
[23]|サンプル23|プレート2|G | 1
[24]|サンプル24|プレート2|H | 1
[25]|サンプル25|プレート2|A | 2
[26]|サンプル26|プレート2|B | 2
[27]|サンプル27|プレート2|C | 2
[28]|サンプル28|プレート2|D | 2
[29]|サンプル29|プレート2|E | 2
[30]|サンプル30|プレート2|F | 2
[31]|サンプル31|プレート2|G | 2
[32]|サンプル32|プレート2|H | 2
[33]|サンプル33|プレート3|A | 1
[34]|サンプル34|プレート3|B | 1
[35]|サンプル35|プレート3|C | 1
[36]|サンプル36|プレート3|D | 1
[37]|サンプル37|プレート3|E | 1
[38]|サンプル38|プレート3|F | 1
[39]|サンプル39|プレート3|G | 1
[40]|サンプル40|プレート3|H | 1
[41]|サンプル41|プレート3|A | 2
[42]|サンプル42|プレート3|B | 2
[43]|サンプル43|プレート3|C | 2
[44]|サンプル44|プレート3|D | 2
[45]|サンプル45|プレート3|E | 2
[46]|サンプル46|プレート3|F | 2
[47]|サンプル47|プレート3|G | 2
[48]|サンプル48|プレート3|H | 2
これと違っていたらスルーしてください。 （IT） 2023/07/31(月) 17:37:19
サンプルシートとしては、IT様の表になります。
C列とD列はプレート上での位置を示しているものです。
とりあえず様と火災報知器様からいただいたコードを基に色々やってみます。
ありがとうございました。
（たこ） 2023/07/31(月) 21:00:27
＞実際のサンプル数は640ありますので、プレート40まで作成します。
火災報知器さんと同じ結果になりますが、別アプローチで。
元データがSheet1にあるとして、
Sub test()
With Worksheets.Add.Range("A1").Resize((16 + (1 * 2)) * 40 / 2) '16サンプル,見出し1行*2列分,40プレート,2列に分ける
.Formula = "=IF(MOD(ROW(),9)=2,INDEX(Sheet1!$B:$B,MOD(ROW()-1,9)+16*INT((ROW()-1)/9)),"""")"
.Offset(, 1).Formula = "=IF(MOD(ROW(),9)<>1,INDEX(Sheet1!$C:$C,MOD(ROW()-1,9)+16*INT((ROW()-1)/9)),"""")"
.Offset(, 2).Formula = "=IF(MOD(ROW(),9)=1,1,INDEX(Sheet1!$A:$A,MOD(ROW()-1,9)+16*INT((ROW()-1)/9)))"
.Offset(, 3).Formula = "=IF(MOD(ROW(),9)=1,2,INDEX(Sheet1!$A:$A,MOD(ROW()-1,9)+16*INT((ROW()-1)/9)+8))"
End With
End Sub
（ベクトル） 2023/07/31(月) 21:01:55
参考までに配列を使ったサンプルです。
Sub SampleByArray()
Dim srcSheet As Worksheet, destSheet As Worksheet
Set srcSheet = Worksheets("Sheet1")
Set destSheet = Worksheets("Sheet2")
Dim srcAry(), destAry(), srcCnt As Long, destCnt As Long
srcAry = srcSheet.Cells(1).CurrentRegion.Value
srcCnt = UBound(srcAry)
destCnt = srcCnt \ 2 + srcCnt \ 16
ReDim destAry(1 To destCnt, 1 To 4)
Dim i As Long, j As Long, k As Long
k = -8
For i = 1 To destCnt
j = (i - 1) Mod 9
If j = 0 Then
destAry(i, 3) = 1
destAry(i, 4) = 2
k = k + 8
Else
If j = 1 Then destAry(i, 1) = srcAry(j + 16 * ((i - 1) \ 9), 2)
k = k + 1
destAry(i, 2) = srcAry(k, 3)
destAry(i, 3) = srcAry(k, 1)
destAry(i, 4) = srcAry(k + 8, 1)
End If
Next
destSheet.Cells(1).Resize(destCnt, 4).Value = destAry
End Sub
（hatena） 2023/08/01(火) 10:03:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.