已结束：VBA抢答题1（2012-4-1）

linch92413

E05:linch92413
Sub shuru()
   Dim R As Long, N As Long
   R = Range("a65536").End(xlUp).Row + 1
   Cells(R, 1) = Range("f2").Value
   Cells(R, 3) = Range("f3").Value
   N = Application.CountIf(Range("a:a"), "B")
   Cells(R, 2) = "B" & N
End Sub
抢1(linch92413).rar (11.02 KB, 下载次数: 2)

2012-4-1 20:24 上传

点击文件名下载附件

jxncfxsf

Sub sr()
Dim m, n As Long
m = Application.CountIf(Range("a:a"), [F2]) + 1
n = Range("a65536").End(xlUp).Row + 1
If [F2] = "" Or [f3] = "" Then
  MsgBox "错误,请重新输入"
   Exit Sub
   End If
  Cells(n, 1) = [F2]
  Cells(n, 2) = [F2] & m
  Cells(n, 3) = [f3]
  

End Sub

zjyxp

1. Sub 抢1()
   
2.     Range("a65536").End(xlUp).Offset(1, 0) = Range("f2")
   
3.     Range("c65536").End(xlUp).Offset(1, 0) = Range("F3")
   
4.     Range("c65536").End(xlUp).Offset(0, -1) = Range("F2") & Application.CountIf(Range("A:A"), Range("F2"))
   
5. End Sub

复制代码

sd6310514

不能上传附件，只能贴代码了，网速不给力啊
Sub cmd()
  Dim LRn As Integer
  Dim i As Integer
  With Sheet1
     LRn = .Range("A65535").End(xlUp).Row + 1
     .Cells(LRn, 1) = .Range("F2")
     .Cells(LRn, 3) = .Range("F3")
     For i = LRn - 1 To 2 Step -1
       If Left(.Cells(i, 2), 1) = .Range("F2") Then
         .Cells(LRn, 2) = .Range("F2") & Val(Replace(.Cells(i, 2), .Range("F2"), "")) + 1
         Exit For
       Else
         .Cells(LRn, 2) = .Range("F2") & 1
       End If
     Next i
  End With
End Sub

ls

Sub 输入()
Range("a" & [a65536].End(3).Offset(1).Row) = [f2]
Range("b" & [b6536].End(3).Offset(1).Row) = [f2].Value & Application.CountIf(Range("a:a"), [f2])
Range("c" & [c65536].End(3).Offset(1).Row) = [f3]

End Sub
抢1.rar (11.04 KB, 下载次数: 2)

2012-4-1 20:39 上传

点击文件名下载附件

hrpotter

C12:hrpotter

1. Sub 输入()
   
2.     Dim i As Integer, j As Integer
   
3.     i = Range("a65536").End(xlUp).Row
   
4.     j = Application.CountIf(Range("a2:a" & i), Range("f2").Value)
   
5.     Cells(i + 1, 1) = Range("f2").Value
   
6.     Cells(i + 1, 2) = Range("f2").Value & j + 1
   
7.     Cells(i + 1, 3) = Range("f3").Value
   
8.     Range("f2:f3").ClearContents
   
9. End Sub

复制代码

C12-hrpotter-抢1.rar (10.95 KB, 下载次数: 2)

2012-4-1 20:46 上传

点击文件名下载附件

wangchangjun

Sub ww()
    Dim x As Integer
    Dim y As Integer
    x = [a65536].End(xlUp).Row
    y = Application.CountIf(Range("a2:a" & x), Range("f2")) + 1
    Range("a" & x + 1).Value = Range("f2").Value
    Range("b" & x + 1).Value = Range("f2") & y
    Range("c" & x + 1).Value = Range("f3")
End Sub 抢1.rar (10.94 KB, 下载次数: 2)

2012-4-1 20:48 上传

点击文件名下载附件

Crystalm

E组 E22  Crystalm 上传第一道抢答题

chenzhi_juan

Sub x()

Dim lastrow As Long, x As Integer, a As Integer

a = 0

lastrow = Range("a" & Cells.Rows.Count).End(xlUp).Row + 1

Cells(lastrow, "a") = Range("f2")
Cells(lastrow, "c") = Range("f3")
For x = 2 To lastrow

   If Cells(x, 1) = Range("f2") Then
   
      a = a + 1
      
    End If
   
Next

Cells(lastrow, "b") = Range("f2") & a


End Sub

梅一枝

Sub ss()
    Dim x As Integer
    Dim y   
y = 1
    For x = 2 To Range("A65536").End(xlUp).Row
        If Range("F2") = Range("A" & x) Then
           y =y+ 1
        End If
    Next x
    Range("A" & x) = Range("F2")
    Range("B" & x) = Range("F2").Value & y
    Range("C" & x) = Range("F3")
End Sub

A06 梅一枝 01.rar (6.97 KB, 下载次数: 4)

2012-4-1 21:19 上传

点击文件名下载附件

A06 梅一枝 附件没指定代码编辑一下