[已解决]求助一个vba的问题

wssbtyy

老师  大师   们 请指点一下关于删除的代码问题

最佳答案

月排行榜 / 总排行榜

suye1010

2016-6-20 10:48

1. Sub DelCol()
   
2. Dim i As Integer, j As Integer, m As Integer, Arr, B As Boolean
   
3. Arr = Range("K1").CurrentRegion
   
4. For m = UBound(Arr, 2) To 1 Step -1
   
5.     B=False
   
6.     For i = UBound(Arr) To 2 Step -1
   
7.         If B = True Then Exit For
   
8.         For j = i - 1 To 2 Step -1
   
9.             If (Arr(j, m)) = Arr(i, m) And Arr(j - 1, m) = Arr(i, m) And Arr(i, m) <> "" Then
   
10.                 Cells(1, m + 10).EntireColumn.Delete
    
11.                 B = True
    
12.                 Exit For
    
13.             End If
    
14.         Next j
    
15.     Next i
    
16. Next m
    
17. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

需要先把问题搞清楚，如图，这个K列到底要不要删除？


我对你的题目理解及其它问题如下：
1、首先要是数组一样，即00,00,00这个形式的，而且是连续两行一样；
2、删除的是整列；
3、跟第一行数组值是否关联？

讲清楚了我再给代码吧！

wssbtyy

老司机带带我 发表于 2016-6-19 20:49
需要先把问题搞清楚，如图，这个K列到底要不要删除？

谢谢老师关注帮忙您说的是对的  数组都是00 00 00格式的 ，而且是在连续二行之后再出现一行，整个列都删除和第一行没有关系

wssbtyy

老司机带带我 发表于 2016-6-19 20:49
需要先把问题搞清楚，如图，这个K列到底要不要删除？

相K列这样的不用删除要是这列在出现一次就删除了

wssbtyy

老司机带带我 发表于 2016-6-19 20:49
需要先把问题搞清楚，如图，这个K列到底要不要删除？

相M列里二个从复的数组之前不还有一组吗，这也不算数，要在这二个从复数组之后开始计算

老司机带带我

wssbtyy 发表于 2016-6-19 22:00
相K列这样的不用删除要是这列在出现一次就删除了

那我又不明白了，K列不是连续出现了吗？为什么不用删除？

wssbtyy

老司机带带我 发表于 2016-6-19 22:03
那我又不明白了，K列不是连续出现了吗？为什么不用删除？

因为K列里在二行从复出现后没有再出现

wssbtyy

wssbtyy 发表于 2016-6-19 22:17
因为K列里在二行从复出现后没有再出现

我这个不好理解在不是以第一行为起始计算的，我的这个是以二行从复的数组一下开始计算的，在二行从复数组之后的行里在有这组数就整列删除

wssbtyy

wssbtyy 发表于 2016-6-19 22:20
我这个不好理解在不是以第一行为起始计算的，我的这个是以二行从复的数组一下开始计算的，在二行从复数组 ...

每列都有二行从复的数，这二行从复的数在哪就以这行为标准

老司机带带我

为了简单点，我参照了你的第一行，代码如下：

1. Sub xx()
   
2.     Dim arr, i&, j&, b As Boolean, c&, r&
   
3.     arr = Sheet1.Range("K1").CurrentRegion
   
4.     c = UBound(arr, 2)
   
5.     r = UBound(arr, 1)
   
6.     For i = c To 1 Step -1
   
7.         b = False
   
8.         For j = 3 To r
   
9.             If j > 3 And b = True And arr(j, i) = arr(1, i) Then
   
10.                 Sheet1.Columns(i + 10).Delete
    
11.             End If
    
12.             If arr(j, i) = arr(j - 1, i) And arr(j, i) = arr(1, i) Then b = True
    
13.         Next
    
14.     Next
    
15. End Sub

复制代码