VBA

Question

我有一个工作表，我想在其中通过输入填充不同的单元格。

目前点击单元格即可。但是，您必须单独单击每个单元格。

现在我希望当我确认第一个单元格中的输入时，第二个值的输入直接出现，这样我就可以连续填写最多 5 个值，而无需每次都单击。

所以我点击一个按钮它应该打开一个输入对话框，在那里我插入我的输入，然后它出现在第一个单元格中，没有关闭它更改为第二个输入 dailog，我再次插入我的输入....

这是我的当前解决方案代码。

我希望你能理解并能帮助我完成这个功能

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim varEintrag
    If Target.Cells(1).Address(0, 0) = "D12" Then
        varEintrag = Application.InputBox("Bitte Wert eintragen", "Dateneingabe")
        If varEintrag <> "Falsch" And varEintrag <> "False" Then
            If IsNumeric(varEintrag) Then
                Target = CDbl(varEintrag)
            Else
                Target = varEintrag
            End If
        End If
    End If
End Sub```

Answer 1

请试试这个修改过的活动。它连续询问5个必要的输入，然后将它们放在必要的范围内：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim varEintrag, arrE(4), i As Long, k As Long
    If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
    
    If Target.cells(1).Address(0, 0) = "D12" Then
        Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
        For i = 0 To UBound(arrE)
            varEintrag = Application.InputBox("Bitte Wert eintragen " & i + 1, "Dateneingabe")
            If varEintrag <> "Falsch" And varEintrag <> "False" Then
                If IsNumeric(varEintrag) Then
                    arrE(k) = CDbl(varEintrag): k = k + 1
                Else
                    arrE(i) = varEintrag: k = k + 1
                End If
            End If
        Next i

        Dim cel As Range: k = 0
        For Each cel In rngRet.cells
            cel.Value = arrE(k): k = k + 1
        Next
    End If
End Sub

已编辑:

这是一个在每个不连续范围单元格之间迭代并要求在每个这样的单元格中输入的版本 address:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
    
    If Target.cells(1).Address(0, 0) = "D12" Then
        Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
        Dim varEintrag, cel As Range
        For Each cel In rngRet.cells
            varEintrag = Application.InputBox("Bitte Wert eintragen in " & cel.Address, "Dateneingabe")
            If varEintrag <> "Falsch" And varEintrag <> "False" Then
                If IsNumeric(varEintrag) Then
                    cel.Value = CDbl(varEintrag)
                Else
                    cel.Value = varEintrag
                End If
            End If
        Next cel
    End If
End Sub

Answer 2

触发多个单元格条目

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ClearError
    
    Const iAddress As String = "D12"
    Const mrgAddress As String = "D12,E12,D13,D15,E15"
    
    Dim iCell As Range
    
    Set iCell = Intersect(Range(iAddress), Target)
    If iCell Is Nothing Then Exit Sub
    
    Dim mrg As Range: Set mrg = Range(mrgAddress)
    
    Application.EnableEvents = False
    
    Dim varEintrag As Variant
    
    For Each iCell In mrg.Cells
        
        varEintrag = Application.InputBox( _
            Prompt:="Bitte Wert in Zelle '" & iCell.Address(0, 0) _
                & "' eintragen:", _
            Title:="Dateneingabe", _
            Default:=iCell.Value)
    
        If varEintrag <> "Falsch" And varEintrag <> "False" Then
            If IsNumeric(varEintrag) Then
                iCell.Value = CDbl(varEintrag)
            Else
                iCell.Value = varEintrag
            End If
        Else
            Exit For ' Cancel
        End If
    
    Next iCell

SafeExit:
    If Not Application.EnableEvents Then Application.EnableEvents = True

    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub

VBA - 不间断地在不同的单元格中插入数据

VBA - Insert data in different cells without interruption

excel

userform

触发多个单元格条目