Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4858 / 76732

←次へ　｜　前へ→


	【77489】Re:数値がプラスマイナスのとき、データ増やす

β - 15/10/16(金) 14:00 -


	引用なし

	パスワード

▼みかさん：

それはよかったです。

一応書きましたので参考まで。

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

1 hits

▼

【77477】数値がプラスマイナスのとき、データ増やす みか 15/10/15(木) 19:42