如果单元格包含特定值,则将某些数据复制到下一个可用行中

时间:2014-09-04 23:55:00

标签: excel excel-vba vba

与许多其他人类似的问题。对于上下文,想要使用此代码来吸引学生。理想情况下,用户滚动列表并为每个缺席的学生放置1。然后填充缺席列表。

我的代码相当简陋,但非常接近我想要它做的事情。但是,如果超过1行中包含“1”,则它将从所有行中提取所有数据,其中包含1。我只希望它拉出输入1的行。我觉得我是一行代码而不是解决这个问题。范围E:我的活动表格中的J是我需要的数据点,加上今天的日期。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer

If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
    For i = 1 To 9999
        If Range("A" & i).Value = 1 Then
            Sheets("Absent List").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Range("E" & i).Value
            Sheets("Absent List").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Range("F" & i).Value
            Sheets("Absent List").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Range("G" & i).Value
            Sheets("Absent List").Range("D" & Rows.Count).End(xlUp).Offset(1).Value = Range("H" & i).Value
            Sheets("Absent List").Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Range("I" & i).Value
            Sheets("Absent List").Range("F" & Rows.Count).End(xlUp).Offset(1).Value = Range("J" & i).Value
            Sheets("Absent List").Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Date
            End If
            Next i
        End If
End Sub

谢谢,

1 个答案:

答案 0 :(得分:0)

通过循环遍历A列,当您遇到值为1时,您总是会复制数据。

相反,如果您将i设置为Target.Row,那么您只会复制更改行的更改。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i As Integer

    If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
        i = Target.Row
        If Range("A" & i).Value = 1 Then
            ' Do your copying
        End If
    End If
End Sub