2

これはそれほど複雑ではないと思いますが、Google に適切な用語を見つけるのにあまり運がなかったので、専門家のところに行きました!

ということで、イベントを開催しようと思いWorksheet_Changeます。それは非常に簡単です、私は基本的に次のことをしたいだけです：

列 C の値が変更され、D の値 (その行) に特定の書式 (NumberFormat = "$ 0.00") がある場合、列 E (その行の) はこれら 2 つの値の積です。簡単。実際には、E 列で式を使用するのと同等の VBA が必要なだけです。これは私が使用しているコードです:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 And Target.Value <> "" Then
    If Target.Offset(0, 1).NumberFormat = "$ 0.00" Then
        Target.Offset(0, 2).Value = Target.Value * Target.Offset(0, 1).Value
        End If
        End If   
end sub

複数の値を c 列の複数の行に貼り付けようとすると、問題が発生します。つまり、データの列 (> 1 行) を C にコピーすると、型の不一致エラーが発生します。「ターゲット」はグループではなく単一のセルであることを意図しているため、これをうまく処理していないという大きな飛躍を遂げます。シートなどでセルが変更されるたびにクレイジーなループを行わずに、これに対処する簡単な方法があることを願っています。

前もって感謝します！

4

2 に答える 2

2

これはあなたがしようとしていることですか？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each aCell In Target
            If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
            End If
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

あなたもこれを読みたいと思うかもしれませんか？

Col C Paste だけをトラップしたかったのですが、ユーザーが複数の列に貼り付けるもう 1 つのシナリオがあります (そのうちの 1 つは Col C です)。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False


    If Not Intersect(Target, Columns(3)) Is Nothing Then
        If Not Target.Columns.Count > 1 Then
            For Each aCell In Target
                If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                    aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
                End If
            Next
        Else
            MsgBox "Please paste in 1 Column"
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub
于 2013-04-21T17:49:01.413 に答える
0

完全性と協力の精神で、私はここに Siddharth Rout の方法のバリエーションを掲載しています。違いは、これは「作用するセル」がすべて 1 つの列にあることに依存しないことです。これにより、少しクリーンになり、他のシナリオに適応しやすくなります。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim onlyThese As Range   ' collection of ranges that, if changed, trigger some action
    Dim cellsToUse As Range  ' cells that are both in "Target" and in "onlyThese"

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set onlyThese = Range("C:C") ' in this instance, but could be anything - even a union of ranges
    Set cellsToUse = Intersect(onlyThese, Target)
    If cellsToUse Is Nothing Then GoTo Letscontinue

    ' loop over cells that were changed, and of interest:
    For Each aCell In cellsToUse
        If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
            aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub
于 2013-04-21T21:20:49.090 に答える