回答編集履歴

1

追記

2019/12/14 02:51

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -23,3 +23,69 @@
23
23
 
24
24
 
25
25
  時間を測ってもらって、みんなで情報を共有できたら幸いかと思います。
26
+
27
+
28
+
29
+ ```ExcelVBA
30
+
31
+ Option Explicit
32
+
33
+
34
+
35
+ Sub test002()
36
+
37
+ Dim v()
38
+
39
+
40
+
41
+ v = cnvMeageCellToValue(ActiveSheet.Range("A1").CurrentRegion)
42
+
43
+
44
+
45
+ Stop
46
+
47
+ End Sub
48
+
49
+
50
+
51
+ Function cnvMeageCellToValue(ByRef Rng As Range) As Variant
52
+
53
+ Const cnsFlag As String = "<空白>"
54
+
55
+ Const cnsBlank As String = ""
56
+
57
+
58
+
59
+ 'Application.ScreenUpdating = False
60
+
61
+
62
+
63
+ Rng.Worksheet.Copy
64
+
65
+ With Workbooks(Workbooks.Count).Worksheets(1).Range(Rng.Address)
66
+
67
+ .Replace cnsBlank, cnsFlag
68
+
69
+ .UnMerge
70
+
71
+ On Error Resume Next
72
+
73
+ .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
74
+
75
+ On Error GoTo 0
76
+
77
+ .Replace cnsFlag, cnsBlank
78
+
79
+ cnvMeageCellToValue = .Value
80
+
81
+ .Worksheet.Parent.Close False
82
+
83
+ End With
84
+
85
+
86
+
87
+ 'Application.ScreenUpdating = True
88
+
89
+ End Function
90
+
91
+ ```