Question

VBA编码全新，但正在开展项目。需要帮助！

我在列J中有一组日期。我必须在单元格B3，C3，D3中手动输入日期....所以直到K3。如果单元格B3到K3中的日期（仅当这些单元格中存在值时）与列J中的日期匹配，那么我必须使用值“创建”自动填充列H. （不必填充B3至K3的所有细胞）。我试过这个编码，但抛出错误。有人可以帮我修改我的代码吗？感谢。

Sub NDate_Input()
'
'Autofill for Create Date & Update Date
'

'
    Worksheets("ORD_CS").Activate
    Dim sht As Worksheet
    Dim LR As Long
    Dim i As Long

    Set sht = ActiveWorkbook.Worksheets("ORD_CS")
    LR = sht.UsedRange.Rows.Count

    With sht
        For i = 8 To LR
            If Range("B3:K3").Value = Range("J" & i).Value Then
                Range("H" & i).Value = "Create"
            End If
        Next i
    End With
End Sub

Answer 1

将此代码放在数据所在的工作表模块中，每次更改B3:K3中的日期时都会触发此代码。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B3:K3")) Is Nothing Then

        If Target.Value <> vbNullString Then

            Dim findMe as Range
            Set findMe = Range("J1:J100000").Find(Target.Value, lookat:=xlWhole)

            If Not findMe Is Nothing Then

                Range("H" & findMe.Row).Value = "Create"

            End If

        End If

    End If

End Sub

Answer 2

你可以试试这个

Option Explicit

Sub NDate_Input()
    Dim i As Long, nVals As Long
    Dim str As String

    With Worksheets("ORD_CS")
        With .Range("B3:K3")
            str = WorksheetFunction.Trim(Join(Application.Transpose(Application.Transpose(.Value)), " "))
            nVals = WorksheetFunction.Count(.Cells)
        End With
        For i = 8 To .UsedRange.Rows.Count
            If WorksheetFunction.Trim(WorksheetFunction.Rept(.Range("J" & i).Value & " ", nVals)) = str Then .Range("H" & i).Value = "Create"
        Next
    End With
End Sub

匹配每个单元格的范围和返回值

2 个答案: