|
>▼Kein さん:
自分で作ってみたのですが・・・初心者なので自信がありません。
実際にいろいろなシチュエーションでテストしましたが・・・うまく動いている気がします。
適用先は書面のレイアウトが変わったのでI列の2つとなりにしましした。
以下のコードを追加しました。
If C.Offset(, 2).Resize(, 10).NumberFormat > "0." & String(4, "0") Then
C.Offset(, 2).Resize(, 10).NumberFormat = "0." & String(4, "0")
End If
これでいいのでしょうか?
よろしくお願いします。
コード全文↓
Sub 小数点桁数整理()
Dim C As Range
Dim Pt As Integer, Nm As Integer
'エラーならElineへ
On Error GoTo ELine
'I列にあるデータの小数点の位置を見つける
For Each C In Range("I:I").SpecialCells(3, 1)
Pt = InStr(1, C.Value, ".")
If Pt > 0 Then
Nm = Len(C.Value) - Pt
'元の場所から右へ2つ行ったセルから10個までのセルに適用する
C.Offset(, 2).Resize(, 10) _
.NumberFormat = "0." & String(Nm + 1, "0")
If C.Offset(, 2).Resize(, 10).NumberFormat > "0." & String(4, "0") Then
C.Offset(, 2).Resize(, 10).NumberFormat = "0." & String(4, "0")
End If
End If
Next
Exit Sub
ELine:
MsgBox "I列に数値を入力したセルがありません", 48
End Sub
|
|