回答編集履歴

1

コード追記

2022/08/21 03:40

投稿

hatena19
hatena19

スコア34352

test CHANGED
@@ -12,7 +12,7 @@
12
12
  Dim i As Long, j As Long, k As Long
13
13
  For i = 1 To rowSize
14
14
  If rngAry(i, 1) <> "" Then
15
- k = k + 1
15
+ k = k + 1
16
16
  For j = 1 To colSize
17
17
  ary(k, j) = rngAry(i, j)
18
18
  Next
@@ -22,3 +22,28 @@
22
22
  Range("F1").Resize(rowSize, colSize).Value = ary
23
23
  End Sub
24
24
  ```
25
+
26
+ 別案
27
+ `SpecialCells(xlCellTypeConstants)` で値のあるセルを取得して、`Union`で纏めて、コピーする。
28
+
29
+ ```vba
30
+ Public Sub sample03()
31
+ Dim rng As Range, colSize As Long
32
+ Set rng = Cells(1).CurrentRegion
33
+ colSize = rng.Columns.Count
34
+ Set rng = rng.SpecialCells(xlCellTypeConstants)
35
+
36
+ Dim r As Range, rng2 As Range
37
+ For Each r In rng
38
+ If rng2 Is Nothing Then
39
+ Set rng2 = r.Resize(, colSize)
40
+ Else
41
+ Set rng2 = Union(rng2, r.Resize(, colSize))
42
+ End If
43
+ Next
44
+
45
+ rng2.Copy Range("F1")
46
+ End Sub
47
+ ```
48
+
49
+