在excel中，改正VBA代码

来源：百度知道 编辑：UC知道 时间：2024/06/01 07:49:51
例如，我有一个工作表1，字段为：编号,名称，面积三个，下面有事先录好有数据。然后，我还有另一个工作表2，字段为：编号,名称，面积三个，不过下面数据为空，我想作的是：当我在工作表2中的A2单元格(固定的)中，输入工作表1中已经存在的编号字段下面的数据时，如编号为1(当然编号有重复，不只有一个，有很多编号等于1)，那么我希望所有编号等于1的行，对应的名称，面积数据在另外两列自动列出(保证名称与面积一一对应)，请大侠帮忙，很有挑战哦！

Private Sub Worksheet_Change(ByVal my As Range)
On Error Resume Next
j = 2
For i = 2 To 10 '假设表一的数据有100行
If Sheet1.Cells(i, 1) = Sheet2.Cells(2, 1) Then
Sheet2.Cells(j, 2) = Sheet1.Cells(i, 2)
Sheet2.Cells(j, 3) = Sheet1.Cells(i, 3)
j = j + 1
End If
Next i
End Sub
上面代码，有些问题，一是:第二列、第三列的数据当一个编号输入后，再输另一个编号，后边两列数据应该先清空再更新,否则有时会加在一起；二是:我输入完a2数据后，点其它单元格，表格会不动，或是很慢
gzxiaofeng :不错，不过还有一个问题，就是工作表2中只能清除第二列和第三列，其它列不能清除;还有就是同一编号对应后面的第二列数据可能有重复，如果重复，那么就显示一个。

已修改：1）限定清空2、3列；2）如记录行重复，只显示1次。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
c = Worksheets(2).UsedRange.Rows.Count
Worksheets(2).Range(Cells(2, 2), Cells(c, 3)).Delete
Set rec = Worksheets(1).Range("A1")
Set result = Range("B2")
key = Range("A2")
Do Until rec = 空值
If rec = key Then
n = n + 1
i = 2
Do Until i > n
If rec.Offset(0, 1).Value = Cells(i, 2).Value And rec.Offset(0, 2).Value = Cells(i, 3).Value Then
GoTo 1
End If
i = i + 1
Loop
result.Value = rec.Offset(0, 1).Value
result.Offset(0, 1).Value = rec.Offset(0, 2).Value
Set result = result.Offset(1, 0)
End If
1:
Set rec = rec.Offset(1, 0)
Loop
Application.EnableEvents = True
End Sub

用下面这段程序，把它放在Sheet2中

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub