2014-09-04 80 views
0

与其他许多其他类似的问题。对于上下文,希望使用此代码为学生提供考勤。理想情况下,用户滚动列表并为每个缺席的学生设置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 

感谢,

回答

0

通过遍历列A,你总是会在你碰到的1

值相反,如果你设置iTarget.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 
相关问题