请帮忙编写VBA代码,如下图片解释

如题所述

Sub xxx()
 arr = Selection
 r = UBound(arr)
 s = r + 1
 For i = r - 1 To 3 Step -1
   If arr(i, 1) = arr(r, 1) And arr(i - 1, 1) = arr(r - 1, 1) And arr(i - 2, 1) = arr(r - 2, 1) Then
     Cells(s, 3) = y - 2
     s = s - 1
     y = 0
     Else
     y = y + 1
  End If
 Next
End Sub

追问

高手还需要稍微改一下,就是我选中如图范围时,计算出来的间隔数就跑上面去了,我希望与选中范围最下单元格并齐。谢谢,还有就是如果我是选择其他的F列中的数据范围时就把计算出来的间隔数还是计算再C列中,我希望能和选中范围列并行计算出结果。

追答Sub xxx()
 arr = Selection
 r = UBound(arr)
 s = Selection.Row + r - 1
 For i = r - 1 To 3 Step -1
   If arr(i, 1) = arr(r, 1) And arr(i - 1, 1) = arr(r - 1, 1) And arr(i - 2, 1) = arr(r - 2, 1) Then
     Cells(s, 3) = y - 2
     s = s - 1
     y = 0
     Else
     y = y + 1
  End If
 Next
End Sub

追问

高手运行可以了,就是我还希望能够把计算出的间隔数放在选中范围列的左侧或右侧列并行单元格中,
因为我试过我选择其他列计算的时候,就是计算的结果还是出现在C列中。

追答Sub xxx()
 arr = Selection
 r = UBound(arr)
 s = Selection.Row + r - 1
 t = selection.column + 1
 For i = r - 1 To 3 Step -1
   If arr(i, 1) = arr(r, 1) And arr(i - 1, 1) = arr(r - 1, 1) And arr(i - 2, 1) = arr(r - 2, 1) Then
     Cells(s, t) = y - 2
     s = s - 1
     y = 0
     Else
     y = y + 1
  End If
 Next
End Sub

追问

高手可以的,嗯我还想问最后两个问题,谢谢
第一个:如果我要把计算出的间隔数放在选中范围的左侧列并行中,要怎么稍微改下?(现代码是右侧列)

第二个是:如果我要计算选中范围的最下四个数在列中的间隔数要怎么稍微改下,就是我现在计算的是三个数,而我想计算四个数要怎么改代码。谢谢

追答

你为啥不一次性说清楚,都没耐心给你改来改去了

Sub xxx()
 arr = Selection
 r = UBound(arr)
 s = Selection.Row + r - 1
 t = selection.column - 1
 For i = r - 1 To 4 Step -1
   If arr(i, 1) = arr(r, 1) And arr(i - 1, 1) = arr(r - 1, 1) And arr(i - 2, 1) = arr(r - 2, 1) and arr(i-3,1)= arr(r-3,1) Then
     Cells(s, t) = y - 2
     s = s - 1
     y = 0
     Else
     y = y + 1
  End If
 Next
End Sub

追问

不好意思,我以为一起问,就容易弄糊涂了的,真不好意思,辛苦了,谢谢,谢谢!

温馨提示:答案为网友推荐,仅供参考