VBA - 如何循环多个单元格以在触发特定单元格时相应地占用数据

Question

我是新手。我迫切需要这个，以便帮助记录我所属的每周自愿捐款的“福利小组”。

我需要有关以下代码中的“循环”如何帮助我在单击或触发单元格 A2 后立即在单元格 C2、D2、E2 和 F2 中输入输入的帮助（下面给出的 VBA 代码可以做到这一点）。 现在，单击单元格 A3 后，单元格 C3、D3、E3 和 F3 也应该立即获取数据。当单击 A4 时，这对于 C4、D4、E4 和 F4 应该是相同的。这应该继续下去。这应该是在 C2:F5 范围内的单元格中输入数据的顺序 （C2、D2、E2、F2 的总和不应超过 B2 中的值） 如果可能的话，我还希望将单元格 C2、D2、E2 和 F2 中捕获的日期分别显示在“输入框”上，以便谨慎输入金额的日期。 请参阅下面的示例表；

        A              B          C              D             E             F
1 |Name of Member| Total Cont.|5th Nov. 23| 12th Nov. 23 |19th Nov. 23| 26th Nov. 23|
2 | Daniel Harry |   300.00   |   100.00  |     50.00    |   29.00    |    121.00   |
3 | Adams Hey    |            |           |              |            |             |
4 | Ayoti Kabri  |            |           |              |            |             |
5 | Adams Ford   |            |           |              |            |             |

希望您理解我想要实现的目标。

但是，这是我一直在解决的代码，但我很困惑。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ClearError

    Const iAddress As String = "A2:A5" 'Loopfor cells A3 to A5
    Const mrgAddress As String = "C2,D2,E2,F2" 'Keep merged cell range unchanged
                    
    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:="Enter Amount to '" & iCell.Address(0, 0) _
                & "' then press Enter:", _
            Title:="AMOUNT TO PAY FOR THIS WEEK", _
            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

请帮助我。请。

Answer 1

试试这个：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const iAddress As String = "A2:A5" 'Loopfor cells A3 to A5
    Const mrgAddress As String = "C1:F1" 'Keep merged cell range unchanged
                    
    Dim iCell As Range, mrg As Range
    Dim varEintrag As Variant
    
    'do we need to handle this selection?
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Me.Range(iAddress), Target) Is Nothing Then Exit Sub
    
    On Error GoTo ClearError
    Set mrg = Target.EntireRow.Range(mrgAddress) "range is *relative* to the row...
    
    Application.EnableEvents = False 'only need this if you also have a "Change" event handler?
    For Each iCell In mrg.Cells
        
        varEintrag = Application.InputBox( _
            prompt:="Enter Amount to '" & iCell.Address(0, 0) _
                & "' then press Enter:", _
            Title:="AMOUNT TO PAY FOR WEEK: " & Me.Cells(1, iCell.Column).Value, _
            Default:=iCell.Value)
    
        If varEintrag <> "Falsch" And varEintrag <> "False" Then
            If IsNumeric(varEintrag) Then varEintrag = CDbl(varEintrag)
            iCell.Value = varEintrag
        Else
            Exit For ' Cancel
        End If
    Next iCell

SafeExit:
    Application.EnableEvents = True
    Exit Sub

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