0

私は、小数点以下 2 桁の数字を扱う作業を頻繁に行っています。私の足し算機には、123456 のような数字の文字列を入力できる優れた機能があり、自動的に小数を挿入して 1234.56 と表示します。Excel には、高度なオプションの下に小数を自動的に入力する機能がありますが、これはグローバル オプションであるため、あまり役に立ちません。そこで、App_SheetChangeイベント ハンドラー用の VBA コードをセットアップしました。このコードは、小数点以下 2 桁の数値を表示するように書式設定されたセルに対してのみ実行されます。そうすれば、必要のない小数を取得できません。コードはとてもシンプルです。次のようになります。

  If InStr(sFormat, "0.00") > 0 Then
    If InStr(".", Source.Formula) = 0 Then
      If IsNumeric(Source.Formula) Then
        s = "00" & Source.Formula
        s = Left(s, Len(s) - 2) & "." & Right(s, 2)
        App.EnableEvents = False
        Source.Formula = CDbl(s)
        App.EnableEvents = True
      End If
    End If
  End If

これは、データを入力するときには十分に機能しますが、別のセルからデータをコピーすると、小数点の後に有効数字がある場合は機能しますが、ゼロの場合は機能しません。データがセルに入力されているか、クリップボードから貼り付けられているかを確認する方法はありますか?

4

2 に答える 2

1

これはどう？

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim r As Excel.Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Target
        If (IsNumeric(r.Value)) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

これにより、セルが数値かどうかがチェックされ、数値の場合は整数かどうかがチェックされます。そうである場合は、100 で割って分数にします。これは、現在行っている文字列操作で行うよりもはるかに高速です。

コピーと貼り付けでもうまく機能します (複数のセルでも)。

ちなみに、これを行いたい各シートにこれを追加する必要があります。

編集:ワークブックレベルになるようにコードを更新しました

于 2013-10-22T17:06:41.663 に答える
1

コードの変更を表示できるように、自分の質問に答える必要があると思いますが、ほとんどの重要な要素がそこにあったので、あなたの答えを受け入れるつもりです。これを編集とコピー/貼り付けの両方で機能させることができました。トリックは、いつ貼り付けているかを認識することでした。次の行で貼り付けているときに終了できることを発見しました。

If Application.CutCopyMode <> 0 Then Exit Sub

コードは次のとおりです。

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim s As String
Dim sFormat As String
Dim iPos As Integer
Dim sDate As String
Dim r As Excel.Range
  On Error GoTo ErrHandler:
  If InStr(Source.Formula, "=") > 0 Then Exit Sub
  If Application.CutCopyMode <> 0 Then Exit Sub
  sFormat = Source.NumberFormat
  iPos = InStr(sFormat, ";")
  If iPos > 0 Then sFormat = Left(sFormat, iPos - 1)
  If InStr(sFormat, "0.00") > 0 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Source
        If (IsNumeric(r.Value)) And (InStr(r.Formula, ".") = 0) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
ErrHandler:
    App.EnableEvents = True
End Sub

これは、App_SheetChange イベントのイベント ハンドラー (Excel ではリスナーと呼ばれますか?) です。このコードをクラス モジュールに入れましたが、この時点ではそれが必要かどうかはわかりません。私はそのファイルを保存し、それを Excel のオプションでアドインとして選択しましたが、どうやってそれを行ったかを覚えておくために少し作業する必要があるでしょう。次に、そのアドインをアクティブにすることを選択したところ、あなたの助けを借りて、機能するようになりました. ありがとう、@ joseph4tw。私のバージョンでは、日付にスラッシュを入れるコードもいくつかあるので、そうする必要はありませんが、これらの改善を加えてそのコードをテストし、機能するかどうかを確認する必要があります.

于 2013-10-22T23:03:55.920 に答える