回答編集履歴
3
修正
test
CHANGED
|
@@ -1,9 +1,49 @@
|
|
|
1
|
-
|
|
1
|
+
こんな感じでどうでしょうか。
|
|
2
2
|
```ここに言語を入力
|
|
3
|
+
Sub test()
|
|
4
|
+
Dim wb As Workbook
|
|
5
|
+
Set wb = ThisWorkbook
|
|
6
|
+
|
|
7
|
+
Dim ws As Worksheet
|
|
8
|
+
Set ws = wb.Sheets("Sheet1")
|
|
9
|
+
|
|
10
|
+
Dim sRow As Long
|
|
11
|
+
Dim mRow As Long
|
|
12
|
+
Dim arry
|
|
13
|
+
Dim x
|
|
14
|
+
Dim i, j
|
|
15
|
+
|
|
16
|
+
|
|
17
|
+
'開始行
|
|
18
|
+
sRow = 4
|
|
19
|
+
'終了行
|
|
20
|
+
mRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
|
|
21
|
+
|
|
22
|
+
j = 1
|
|
23
|
+
|
|
24
|
+
'L列目が空白の場合は配列へ格納
|
|
25
|
+
ReDim x(1 To mRow)
|
|
26
|
+
|
|
27
|
+
For i = sRow To mRow
|
|
28
|
+
|
|
29
|
+
arry = ws.Range(ws.Cells(i, 1), ws.Cells(i, 29))
|
|
30
|
+
|
|
3
|
-
|
|
31
|
+
If Not Cells(i, 12) = "" Then
|
|
4
|
-
For k = 1 to 29
|
|
5
|
-
x(j
|
|
32
|
+
x(j) = arry
|
|
6
|
-
Next
|
|
7
|
-
j = j + 1
|
|
33
|
+
j = j + 1
|
|
8
34
|
End If
|
|
35
|
+
|
|
36
|
+
Next i
|
|
37
|
+
|
|
38
|
+
|
|
39
|
+
'最大要素数の調整
|
|
40
|
+
ReDim Preserve x(1 To j - 1)
|
|
41
|
+
|
|
42
|
+
'元々セル入っていた分(A4からR最終行まで)を削除
|
|
43
|
+
Range("A4:AC" & mRow).ClearContents
|
|
44
|
+
|
|
45
|
+
'配列に格納している分を貼付
|
|
46
|
+
Range("A4:AC" & UBound(x) + 3) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(x))
|
|
47
|
+
|
|
48
|
+
End Sub
|
|
9
49
|
```
|
2
修正
test
CHANGED
|
@@ -4,6 +4,6 @@
|
|
|
4
4
|
For k = 1 to 29
|
|
5
5
|
x(j, k) = arry(1, k)
|
|
6
6
|
Next
|
|
7
|
+
j = j + 1
|
|
7
8
|
End If
|
|
8
|
-
j = j + 1
|
|
9
9
|
```
|
1
修正
test
CHANGED
|
@@ -1,8 +1,9 @@
|
|
|
1
1
|
とりあえず
|
|
2
2
|
```ここに言語を入力
|
|
3
3
|
If Not Cells(i, 12) = "" Then
|
|
4
|
-
For
|
|
4
|
+
For k = 1 to 29
|
|
5
|
-
x(
|
|
5
|
+
x(j, k) = arry(1, k)
|
|
6
6
|
Next
|
|
7
7
|
End If
|
|
8
|
+
j = j + 1
|
|
8
9
|
```
|