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

chrissha

C10: chrissha
抢3.rar (7.21 KB, 下载次数: 11)

2012-4-1 22:01 上传

点击文件名下载附件
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Myrange As Range
Range("A4:D100").Clear
For Each Myrange In Range("K:K")
If Myrange = Range("B2") Then
Range(Myrange.Offset(1, 0), Myrange.End(xlDown).Offset(0, 3)).Copy Range("A4")
End If
Next
Application.EnableEvents = True
End Sub

mfksypss

Sub sx()
Dim arr, st$, n%, rg As Range, ar(1 To 5), rgg As Range, x%
st = [b2]
    arr = Application.Transpose(Range("A4:A6"))
    ReDim Preserve arr(1 To 5)
    arr(4) = "学历"
    arr(5) = "性别"
If Application.WorksheetFunction.Match(st, Range("K1:k" & Range("K" & Rows.Count).End(xlUp).Row), 0) > 0 Then
    n = Application.WorksheetFunction.Match(st, Range("K1:k" & Range("K" & Rows.Count).End(xlUp).Row), 0)
   Set rg = Range("K" & n & ":N" & Range("K" & n).End(xlDown).Row)
    For x = 1 To 5
        For Each rgg In rg
            If arr(x) = rgg Then
                ar(x) = Cells(rgg.Row, rgg.Column + 1)
                Exit For
            End If
        Next rgg
    Next x
End If
[b4] = ar(1)
[b5] = ar(2)
[b6] = ar(3)
[d4] = ar(4)
[d5] = ar(5)
End Sub

yl_li

B19-yl_li
终于理解题意了
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim j As Integer
    If Target.Address = "$B$2" Then
        Application.EnableEvents = False
        i = WorksheetFunction.Match(Target.Value, Range("k:k"), 0)
        j = Range("k" & i).End(xlDown).Row
        Range("a4:d" & Range("a65536").End(xlUp).Row).Clear
        Range("K" & i + 1 & ":n" & j).Copy Range("a4")
        Application.EnableEvents = True
    End If
End Sub

抢3.rar (9.35 KB, 下载次数: 13)

2012-4-1 22:04 上传

点击文件名下载附件

我不知道呀

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim i As Integer
    Dim x As Integer
    Range("a4:d8").Clear
    With Worksheets(1).Range("k2:n36")
        Set c = .Find(Cells(2, 2), LookIn:=xlValues)
        If Not c Is Nothing Then
            x = Range(c.Address).End(xlDown).Row
            y = Range(c.Address).Row
            Range("a4").Resize(x - y, 4) = Range(c.Address).Offset(1, 0).Resize(x - y, 4).Value
        End If
    End With
    Application.EnableEvents = True
End Sub

我不知道呀

兰校长，我刚看完你上传的动画，这次重做一次

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim i As Integer
    Dim x As Integer
    Range("a4:d8").Clear
    With Worksheets(1).Range("k2:n36")
        Set c = .Find(Cells(2, 2), LookIn:=xlValues)
        If Not c Is Nothing Then
            x = Range(c.Address).End(xlDown).Row
            y = Range(c.Address).Row
            Range(c.Address).Resize(x - y, 4).Copy Destination:=Range("a4")     
        End If
    End With
    Application.EnableEvents = True
End Sub

mfksypss

Sub sx()
Dim st$, rg As Range, n%
st = [b2]
Range("A4").CurrentRegion.Delete Shift:=xlUp
If Application.WorksheetFunction.Match(st, Range("K1:k" & Range("K" & Rows.Count).End(xlUp).Row), 0) > 0 Then
    n = Application.WorksheetFunction.Match(st, Range("K1:k" & Range("K" & Rows.Count).End(xlUp).Row), 0)
   Set rg = Range("K" & n & ":N" & Range("K" & n).End(xlDown).Row)
   rg.Copy [a4]
End If
End Sub

一缕忧兰

抢3.zip (10.03 KB, 下载次数: 13)

2012-4-1 22:13 上传

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

1. 
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3. Dim R As Range, E As Integer, F As Integer
   
4. With Target
   
5.   If .Address = "$B$2" Then
   
6.     Range("A4:D10").Clear
   
7.     Application.EnableEvents = False
   
8.     Set R = Sheet3.Columns("K:K").Find(.Value, , , 1)
   
9.     If Not R Is Nothing Then E = R.Row Else Exit Sub
   
10.     F = Cells(E, "K").End(xlDown).Row
    
11.     Cells(E + 1, "K").Resize(F - E, 4).Copy Range("A4")
    
12.     Application.EnableEvents = True
    
13.   End If
    
14. End With
    
15. End Sub
    

复制代码

gaoshuichang1

F10:gaoshuichang1
抢3.zip (7.59 KB, 下载次数: 2)

2012-4-1 22:17 上传

点击文件名下载附件

Sub aa()
Dim x As Integer
x = WorksheetFunction.Match(Range("b2"), Range("k:k"), 0)
Range("b4") = Range("k" & x).Offset(1, 1)
Range("b5") = Range("k" & x).Offset(2, 1)
Range("b6") = Range("k" & x).Offset(3, 1)
Range("d4") = Range("k" & x).Offset(1, 3)
Range("d5") = Range("k" & x).Offset(2, 3)
Range("d6") = Range("k" & x).Offset(3, 3)
End Sub

byhdch

A09:byhdch

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$B$2" Then
        Dim j As Integer
        j = Application.Match(Range("b2"), Range("k:k"), 0)
        Range("a3:d7").Clear
        Cells(j, 11).CurrentRegion.Select
        Selection.Copy
        Range("a3").Select
        ActiveSheet.Paste
    End If
End Sub

抢3.rar (7.2 KB, 下载次数: 2)

2012-4-1 22:17 上传

点击文件名下载附件

wangchangjun

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y
If Target.Address = "$B$2" Then
Range("a4:d8").ClearContents
    x = Application.Match(Range("b2"), Range("k2:k32"), 0)
    y = Application.CountA(Range(Range("k" & x + 1), Range("k" & x + 4)))
    Range("k" & x + 2).Resize(y, 4).Select
    Selection.Copy
    Range("A4").Select
    ActiveSheet.Paste
    End If
End Sub
抢3.rar (10.48 KB, 下载次数: 2)

2012-4-1 22:20 上传

点击文件名下载附件