| |
▼みか さん：
それはよかったです。
一応書きましたので参考まで。
Sub Test2()
Dim v As Variant
Dim x As Long
Dim y As Long
Dim r As Range
With Range("X1", Range("X" & Rows.Count).End(xlUp)).Resize(, 3)
ReDim v(1 To .Rows.Count)
For Each r In .Rows
x = x + 1
v(x) = getDim(r)
Next
End With
Columns("X:Z").ClearContents
y = 1
For x = 1 To UBound(v)
Cells(y, "X").Resize(UBound(v(x), 1), 3).Value = v(x)
y = Range("X" & Rows.Count).End(xlUp).Row + 1
Next
End Sub
Private Function getDim(r As Range) As Variant
Dim wX As Variant
Dim wY As Variant
Dim wZ As Variant
Dim dX As Variant
Dim dY As Variant
Dim dZ As Variant
Dim v As Variant
Dim n As Variant
Dim x As Long
ReDim v(1 To 2 * 2 * 2, 1 To 3)
n = r.Cells(1, 1).Value
If Left(n, 1) = "±" Then
ReDim wX(1 To 2)
wX(1) = Mid(n, 2)
wX(2) = Mid(n, 2) * -1
Else
ReDim wX(1 To 1)
wX(1) = n
End If
n = r.Cells(1, 2).Value
If Left(n, 1) = "±" Then
ReDim wY(1 To 2)
wY(1) = Mid(n, 2)
wY(2) = Mid(n, 2) * -1
Else
ReDim wY(1 To 1)
wY(1) = n
End If
n = r.Cells(1, 3).Value
If Left(n, 1) = "±" Then
ReDim wZ(1 To 2)
wZ(1) = Mid(n, 2)
wZ(2) = Mid(n, 2) * -1
Else
ReDim wZ(1 To 1)
wZ(1) = n
End If
For Each dX In wX
For Each dY In wY
For Each dZ In wZ
x = x + 1
v(x, 1) = dX
v(x, 2) = dY
v(x, 3) = dZ
Next
Next
Next
getDim = v
End Function
|
|
β
- 15/10/16(金) 17:27 -
Nobu10
- 15/10/16(金) 17:10 -
キキ
- 15/10/16(金) 16:52 -
ウッシ
- 15/10/16(金) 15:57 -
