论坛 › Excel VBA实战营2期 › 第7课练习题：连续排序号

风行天边789 发表于 2012-2-28 15:28

呵呵，发了一次了。

qushui 发表于 2012-2-28 15:44

Option Explicit
Sub 练习()
Dim i%, a%
Cells(2, 3) = 1
a = Cells(Rows.Count, 1).End(3).Row
For i = 3 To a
If Cells(i, 1) - Cells(i - 1, 1) = 1 Then
Cells(i, 3) = Cells(i - 1, 3) + 1
Else
Cells(i, 3) = 1
End If
Next i
End Sub

linch92413 发表于 2012-2-28 16:29

E05:linch92413　交答案

Sub bx()
   Dim i As Long
   Dim j As Long
   j = 1
   For i = 2 To Range("a65536").End(xlUp).Row
      Cells(i, 2) = j
      If Cells(i + 1, 1) = Cells(i, 1) + 1 Then
         j = j + 1
      Else
         j = 1
      End If
   Next i
End Sub

ykymj 发表于 2012-2-28 16:59

Sub 计算连号个数()
Dim x, y As Integer
For x = 2 To 16
    If x = 2 Then
      y = 1
    ElseIf Range("A" & x).Value = Range("A" & x).Offset(-1, 0) + 1 Then
      y = y + 1
    Else: y = 1
    End If
   
Range("B" & x) = y

Next x


End Sub

qzc804030 发表于 2012-2-28 17:05

E组长:qzc804030

linmm 发表于 2012-2-28 23:42

上课才知道有练习题，课后再做，明白用加法做出来是不对的，只能用减法

在路上882 发表于 2012-2-28 23:54

好复杂呀！我要多久可以掌握呀

liuho1 发表于 2012-2-29 11:02

错过了，昨天没看到

yl_li 发表于 2012-2-29 16:36

自己写的2个
Sub aa()
Dim i As Integer
Dim j As Integer
Range("b2") = 1
j = 2
    For i = 3 To 16
      If Cells(i, 1) = Cells(i - 1, 1) + 1 Then
            Cells(i, 2) = j
            j = j + 1
      Else
            j = 1
            Cells(i, 2) = j
            j = j + 1
      End If
    Next i
End Sub
Sub bb()
Dim i As Integer
    For i = 2 To 16
      If Cells(i, 1) - 1 <> Cells(i - 1, 1) Then
            Cells(i, 2) = 1
      Else
            Cells(i, 2) = Cells(i - 1, 2) + 1
      End If
    Next i
End Sub

1982zyh 发表于 2012-3-1 11:11

Sub 排序()

Dim x As Integer

For x = 2 To 16
   
    If x = 2 Then
   
      Cells(x, 2) = 1
      
    ElseIf Cells(x, 1) = Cells(x - 1, 1) + 1 Then
   
      Cells(x, 2) = Cells(x - 1, 2) + 1
      
    ElseIf Cells(x, 1) <> Cells(x - 1, 1) + 1 Then
   
      Cells(x, 2) = 1
            
      
    End If
   
Next x

End Sub

查看完整版本: 第7课练习题：连续排序号