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

兰色幻想

     具体要求看附件内，本贴为回复可见。可以直接提交答案。提交答案时请把附件一并提交。
     奖励前10名，分别奖励10~1个积分
    抢3.rar (4.45 KB, 下载次数: 195)

2012-4-1 19:56 上传

点击文件名下载附件

zhouyunj

做题 中，  ：）  哈哈  沙发！

mfk1288

1组：mfk1288(旧号）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$2" Then
        Dim a As Integer, i As Integer
        a = Application.Match(Range("B2"), Range("K:K"), 0)
        If IsNumeric(a) Then
            For i = 4 To 6
                Cells(i, "B") = Cells(a + i - 3, "l")
            Next
            For i = 4 To 5
                Cells(i, "d") = Cells(a + i - 3, "n")
            Next
        End If
    End If
End Sub
抢3.rar (7.41 KB, 下载次数: 10)

2012-4-1 20:23 上传

点击文件名下载附件

hrpotter

C12:hrpotter

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim st As String
   
3.     Dim i As Integer, j As Integer
   
4.     If Target.Address = "$B$2" Then
   
5.         st = Range("b2")
   
6.         i = Application.Match(st, Range("k1:k36"), 0)
   
7.         j = Cells(i, "k").End(xlDown).Row
   
8.         Range("a4:d65536").Clear
   
9.         Range("a4").Resize(j - i, 4) = Range(Cells(i + 1, "k"), Cells(j, "n")).Value
   
10.     End If
    
11. End Sub

复制代码

C12-hrpotter-抢3.rar (9.7 KB, 下载次数: 31)

2012-4-1 20:28 上传

点击文件名下载附件

liuho1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target = Range("b2") Then
a = Application.WorksheetFunction.Match(Range("B2"), Range("k:k"), 0)
Range("b4") = Range("L" & a + 1)
Range("b5") = Range("L" & a + 2)
Range("b6") = Range("L" & a + 3)
Range("d4") = Range("n" & a + 1)
Range("d5") = Range("n" & a + 2)
End If
End Sub
心急老是看错

wangchangjun

Sub ww()
    Dim x
    x = Application.Match(Range("b2"), Range("k2:k32"), 0)
    Range("b4") = Range("l" & x + 2)
    Range("b5") = Range("l" & x + 3)
    Range("b6") = Range("l" & x + 4)
End Sub 抢3.rar (7.77 KB, 下载次数: 10)

2012-4-1 20:37 上传

点击文件名下载附件

禾火亦

1. Sub chazhao()
   
2. Dim rng As Range, rng1 As Range
   
3. Set rng1 = Range(Range("k2"), Range("k" & Range("k65536").End(3).Row))
   
4. Set rng = WorksheetFunction.Index(rng1, WorksheetFunction.Match(Range("b2"), rng1, 0))
   
5. Range("b4") = rng.Offset(1, 1)
   
6. Range("d4") = rng.Offset(1, 3)
   
7. Range("b5") = rng.Offset(2, 1)
   
8. Range("d5") = rng.Offset(2, 3)
   
9. Range("b6") = rng.Offset(3, 1)
   
10. End Sub
    

复制代码

yl_li

b19-yl_li

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
    If Target.Address = "$B$2" Then
        i = WorksheetFunction.Match(Target.Value, Range("k:k"), 0)
        Range("b4").Value = Range("k" & i).Offset(1, 1)
        Range("d4").Value = Range("k" & i).Offset(1, 3)
        Range("b5").Value = Range("k" & i).Offset(2, 1)
        Range("d5").Value = Range("k" & i).Offset(2, 3)
        Range("b6").Value = Range("k" & i).Offset(3, 1)
    End If
End Sub

抢3.rar (8.68 KB, 下载次数: 5)

2012-4-1 20:42 上传

点击文件名下载附件

chenzhi_juan

Option Explicit

Private Sub Workbook_Open()

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim lastrow As Long

lastrow = Range("k" & Cells.Rows.Count).End(xlUp).Row

Dim a As Integer, b As Integer, rg As Range, rg1 As Range

b = 2

If Target.Address = "$B$2" Then

  For a = 2 To lastrow
     
     If Cells(a, "k") = Target.Value Then
     
        b = a + 1
        
      Else
      
      If Cells(a, "k") = "" Then
      
          For Each rg1 In Range("a4:c6")
      
         For Each rg In Range(Cells(b, "k"), Cells(a - 1, "n"))
         
                        
             If rg.Value = rg1.Value Then
            
                rg1.Offset(0, 1) = rg.Offset(0, 1)
               
                Exit For
               
             End If
            
             Next
            
          Next
         
        
         
          End If
         
        End If
        
    Next
            
End If

End Sub

zjyxp

1. Sub 抢3()
   
2. Dim kkk As Integer
   
3. 
   
4. kkk = Application.Match(Range("b2"), Range("K:K"), 0)
   
5. Range("b4").Value = Range("K" & kkk).Offset(1, 1).Value
   
6. Range("b5").Value = Range("K" & kkk).Offset(2, 1).Value
   
7. Range("b6").Value = Range("K" & kkk).Offset(3, 1).Value
   
8. Range("d4").Value = Range("K" & kkk).Offset(1, 3).Value
   
9. Range("d5").Value = Range("K" & kkk).Offset(2, 3).Value
   
10. End Sub
    

复制代码