| 
    
     |  | >▼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
 
 
 |  |