[已解决]请各位老师帮忙，完成一段VBA代码，谢谢啦！

wbzxz

楼主是不是这个意思，请将以下代码放入Sheet1中。

1.   Dim endRow As Long
   
2.   Application.EnableEvents = False
   
3.   If Not Application.Intersect(Target, Range("G1:J1")) Is Nothing Then
   
4.     endRow = Range("A" & Rows.Count).End(xlUp).Row
   
5.     If Target.Value = 1 Or Target.Value = 2 Or Target.Value = 3 Or Target.Value = 4 Then
   
6.       Cells(1, Target).Resize(endRow, 1).Copy Target
   
7.     Else
   
8.       Target.Resize(endRow, 1).Clear
   
9.     End If
   
10.   End If
    
11.   Application.EnableEvents = True
    
12. End Sub

复制代码

详细内容见附件。
Book1 (12).rar (12.3 KB, 下载次数: 2)

2011-8-14 07:39 上传

点击文件名下载附件

zjdh

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Not Intersect(Range("G1:J1"), Target) Is Nothing Then
   
3.         Application.EnableEvents = False
   
4.         ARR = Range("A2:D" & Range("A65536").End(3).Row)
   
5.         For I = 2 To UBound(ARR) + 1
   
6.             Cells(I, Target.Column) = ARR(I - 1, Target.Value)
   
7.         Next
   
8.         Application.EnableEvents = True
   
9.     End If
   
10. End Sub

复制代码

liuts

回复 haiyang81 的帖子

Book1.rar (200.51 KB, 下载次数: 3)

2011-8-14 08:40 上传

点击文件名下载附件
lianshou

fjmxwrs

回复 haiyang81 的帖子

就一句话。
Book1(3).rar (11.54 KB, 下载次数: 2)

2011-8-14 09:05 上传

点击文件名下载附件

1. 
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim r&
   
4.     If Not Intersect(Range("G1:J1"), Target) Is Nothing Then
   
5.         r = Cells(65536, Target.Value).End(xlUp).Row - 1
   
6.         Cells(2, Target.Value).Resize(r, 1).Copy Cells(2, Target.Column)
   
7.     End If
   
8. End Sub
   

复制代码

fjmxwrs

回复 haiyang81 的帖子

你用什么方法赋值？

1. 
   
2. 
   
3. Sub aa()
   
4. With Sheet1
   
5. .Range("G:J").ClearContents
   
6. .Range("G1:J1") = Array(1, 2, "", "")
   
7. n = Array(1, 2, "", "")
   
8. For x = 1 To 4
   
9. i = n(x - 1)
   
10. If i = "" Then GoTo aaa
    
11. r = .Cells(65536, i).End(xlUp).Row
    
12. .Cells(2, i).Resize(r, 1).Copy Cells(2, x + 6)
    
13. aaa:
    
14. Next x
    
15. End With
    
16. 
    
17. End Sub

复制代码

Book1(3).rar (13.18 KB, 下载次数: 2)

2011-8-14 10:26 上传

点击文件名下载附件