已结束：抢3（2012-4-1）

xiaoni

抢3.rar (9.02 KB, 下载次数: 10)

2012-4-1 21:20 上传

点击文件名下载附件
麻烦校长批改作业
Sub aa()
Range("a4:d10").Clear
    Dim i As Long, m%
    m = Application.Match(Range("b2"), Range("k:k"), 0)
    For i = m To 40
        If Cells(i, "k") = "" Then
            Range("k" & m).Resize(i - m, 4).Copy Range("a4")
            Exit For
        End If
    Next i
End Sub

chrissha

C10: Chrissha
抢3.rar (7.16 KB, 下载次数: 11)

2012-4-1 21:23 上传

点击文件名下载附件

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Myrange As Range
For Each Myrange In Range("K:K")
If Myrange = Range("B2") Then
Range(Myrange.Offset(1, 0), Myrange.Offset(4, 3)).Copy Range("A4")
End If
Next
Application.EnableEvents = True
End Sub

ls

ls 发表于 2012-4-1 21:01
Sub 按钮3_Click()
    [a3:d100].Clear
    Range("k:k").Find().CurrentRegion.Resize(, 4).Copy Activ ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 2 And Target.Column = 2 Then
        [a3:d100].Clear
        Range("k:k").Find([b2]).CurrentRegion.Resize(, 4).Copy ActiveSheet.[a3]
        [a3].Clear
    End If
End Sub

抢3.rar (9 KB, 下载次数: 12)

2012-4-1 21:26 上传

点击文件名下载附件

一缕忧兰

抢3.zip (9.66 KB, 下载次数: 16)

2012-4-1 21:25 上传

点击文件名下载附件
A07:一缕忧兰

sd6310514

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MatchRn
    Dim Rn As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range("A4").Resize(10, 4).Clear
    MatchRn = Application.Match(Range("B2"), Range("K:K"), 0)
    If Not IsError(MatchRn) Then
        Rn = Range("K" & MatchRn).End(xlDown).Row
        Range("K" & MatchRn).Resize(Rn - MatchRn + 1, 4).Copy
        Range("A4").Select
        ActiveSheet.Paste
    End If
    Range("B2").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

liuho1

Private Sub Worksheet_Change(ByVal Target As Range)

If Target = Range("b2") Then
range("a2:D8")=""
a = Application.WorksheetFunction.Match(Range("B2"), Range("k:k"), 0)
b = Range("k" & a).End(xlDown).Row
For c = 1 To b - a
Range("a" & (3 + c)) = Range("k" & a + c)
Range("b" & (3 + c)) = Range("L" & a + c)
Range("c" & (3 + c)) = Range("m" & a + c)
Range("d" & (3 + c)) = Range("n" & a + c)
Next
End If

End Sub

wenchduan

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim H As Long
   
3. With Target
   
4.   If .Address = "$B$2" Then
   
5.     Application.EnableEvents = False
   
6.     H = Application.Match(.Value, Range("K:K"), 0)
   
7.     .Offset(2) = Cells(H + 1, "L")
   
8.     .Offset(2, 2) = Cells(H + 1, "N")
   
9.     .Offset(3) = Cells(H + 2, "L")
   
10.     .Offset(3, 2) = Cells(H + 2, "N")
    
11.     .Offset(4) = Cells(H + 2, "N")
    
12.     Application.EnableEvents = True
    
13.   End If
    
14. End With
    
15. End Sub

复制代码

A 组长：wenchduan

wangchangjun

抢3.rar (8.71 KB, 下载次数: 12)

2012-4-1 21:36 上传

点击文件名下载附件
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
If Target.Address = "$B$2" Then
    x = Application.Match(Range("b2"), Range("k2:k32"), 0)
    Range("k" & x + 2).Resize(4, 4).Select
    Selection.Copy
    Range("A4").Select
    ActiveSheet.Paste
    End If
End Sub

byhdch

A09:byhdch

Sub 生成信息()
    Dim j As Integer, i As Integer
    For i = 1 To 4
        j = Application.Match(Range("b2"), Range("k:k"), 0)
        Cells(i + 3, 2) = Cells(j + i, "l")
        Cells(i + 3, 4) = Cells(j + i, "n")
    Next i
End Sub

抢3.rar (7.57 KB, 下载次数: 12)

2012-4-1 21:40 上传

点击文件名下载附件

chenzhi_juan

小组号：H19
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
   
Range("a4:d15").Clear

Dim a As Integer, b As Integer

a = Application.WorksheetFunction.Match(Range("b2"), Range("k1:k36"), 0)
b = Range("k" & a).End(xlDown).Row

Debug.Print a, b
Range(Cells(a + 1, "k"), Cells(b, "n")).Copy Range("a4")



Application.EnableEvents = True


End Sub