Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1682|回复: 3

VBA算出连续相同值的上标与下标

[复制链接]
发表于 2017-8-22 14:08 | 显示全部楼层 |阅读模式
有没有办法用VBA循环,算出一列中,连续相同块的上标和下标呢?求一个算法,求一个思路
1.png

工作簿1.rar

6.39 KB, 下载次数: 4

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-8-22 14:29 | 显示全部楼层
  1. Sub grf()
  2.     arr = Range("a1:a" & [a65536].End(3).Row + 1)   '定义数组比源数组大1行,以便和最后一行比较
  3.     ReDim brr(1 To UBound(arr), 1 To 1)
  4.     s = 1
  5.     For i = 2 To UBound(arr)
  6.         If arr(i, 1) <> arr(i - 1, 1) Then
  7.             e = i - 1
  8.             If s < e Then brr(s, 1) = s: brr(e, 1) = e
  9.             s = i
  10.         End If
  11.     Next
  12.     [c1].Resize(i - 1) = brr
  13. End Sub
复制代码

工作簿1.rar

13.89 KB, 下载次数: 5

评分

参与人数 2 +15 收起 理由
lidayu + 3 很给力
苏子龙 + 12 神马都是浮云

查看全部评分

回复

使用道具 举报

发表于 2017-8-22 18:05 | 显示全部楼层
上下比较,与上面不同,下面相同为上标;与上面相同,下面不同为下标;其余的为空值
回复

使用道具 举报

发表于 2017-8-24 09:54 | 显示全部楼层
3楼的思路不错。
  1. Sub grf()
  2.     arr = Range("a1:a" & [a65536].End(3).Row + 1)   '定义数组比源数组大1行,以便和最后一行比较
  3.     ReDim brr(1 To UBound(arr), 1 To 1)
  4.     If arr(1, 1) = arr(2, 1) Then brr(1, 1) = 1
  5.     For i = 2 To UBound(arr) - 1
  6.         If (arr(i, 1) <> arr(i - 1, 1) And arr(i, 1) = arr(i + 1, 1)) Or _
  7.            (arr(i, 1) <> arr(i + 1, 1) And arr(i, 1) = arr(i - 1, 1)) Then
  8.             brr(i, 1) = i
  9.         End If
  10.     Next
  11.     [c1].Resize(i - 1) = brr
  12. End Sub
复制代码

评分

参与人数 1 +16 收起 理由
ppp710715 + 16 很给力

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 04:42 , Processed in 0.531188 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表