在第2-100行中重复函数的VBA代码

Question

我对VBA代码没有什么经验，我正试图让这些代码在2-100行中重复。与其他在行中重复的代码相比，我发现的问题是我的代码有多个结束参数，我不知道如何解释这一点。非常感谢您的帮助。

Private Sub Worksheet_SelectionChange2(ByVal Target As Range)
a = Date
b = 2
If Cells(b, 3).Value <> Blank Then
If Cells(b, 2).Value = Blank Then
Cells(b, 2).Value = a
Exit Sub
End If
If Cells(b, 2).Value < a Then
Exit Sub
End If
Cells(b, 2).Value = a
End If
End Sub

这就是我正在处理的问题。我试图使单元格引用成为一个可以计数的变量，但无论我尝试了什么，它都不起作用。

编辑：很抱歉没有澄清。当C2从空变为有任何内容时，该代码应该将今天的日期放在B2中。如果已经有日期，即使C2被清除，它也可以防止日期被更改。我试图扩展它，使它不仅仅是C2和B2，而是C2-C100，然后是相应的B2-B100。

编辑2:C2通过手动输入进行更改。目的是让某人将数据输入C2(以及行的其余部分(，并自动输入和锁定日期，这样他们就无法更改日期，我可以看到数据是何时输入的。

Answer 1

工作表更改(时间戳(

• 只有手动修改列C中的值，即通过手动输入、复制/粘贴和通过VBA写入，此操作才会起作用

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ClearError

Const fRow As Long = 2
Const sCol As String = "C"
Const dCol As String = "B"

Dim scrg As Range: Set scrg = Columns(sCol).Resize(Rows.Count - fRow + 1)

Dim srg As Range: Set srg = Intersect(scrg, Target)
If srg Is Nothing Then Exit Sub

Dim drg As Range
Dim dCell As Range
Dim sCell As Range

For Each sCell In srg.Cells
Set dCell = sCell.EntireRow.Columns(dCol)
If Len(CStr(dCell.Value)) = 0 Then
If drg Is Nothing Then
Set drg = dCell
Else
Set drg = Union(drg, dCell)
End If
End If
Next sCell

' All cells already contain a date.
If drg Is Nothing Then Exit Sub

Dim dDate As Date: dDate = Now ' after prooving that it works, use 'Date'

' To prevent retriggering this event and any other event while writing.
Application.EnableEvents = False

' Write in one go.
drg.Value = dDate

SafeExit:
' Enable events 'at any cost'.
If Not Application.EnableEvents Then Application.EnableEvents = True
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub