[已解决]函数公式求助无果 来VBA求解

hanjia

2,5,8这3个数字其中有2个相连就判断   像F列或者G列那么显示
A1是5 , A2是2, 判断到8在第3行就在F3显示0
A6是8 , A7是5, 判断到2在第12行就在F12显示0
A14是2 , A15是8, 判断到5在第19行就在F19显示0



新建 Microsoft Excel.rar (7.07 KB, 下载次数: 9)

2014-8-28 12:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2014-8-28 13:02

1. Sub t()
   
2.   Dim arr, i&, line&, sr$, re(), cnt&, j&, k%, m&
   
3.   arr = Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.   ReDim re(1 To UBound(arr), 1 To 2)
   
5.   sr = 258
   
6.   For i = 1 To UBound(arr)
   
7.      If sr Like "*" & arr(i, 1) & "*" Then
   
8.         cnt = cnt + 1
   
9.         sr = Replace(sr, arr(i, 1), "")
   
10.      End If
    
11.      If cnt = 2 Then
    
12.         line = i
    
13.         For j = line + 1 To UBound(arr)
    
14.            For k = 1 To UBound(arr, 2)
    
15.               If CStr(arr(j, k)) = sr Then
    
16.                  re(j, 1) = 0: re(j, 2) = 0
    
17.                  For m = i + 1 To j - 1
    
18.                     re(m, 1) = m - i
    
19.                     re(m, 2) = j - m
    
20.                  Next
    
21.                  sr = 258
    
22.                  cnt = 0
    
23.                  i = j
    
24.                  GoTo nextline
    
25.               End If
    
26.            Next
    
27.         Next
    
28. nextline:
    
29.      End If
    
30.   Next
    
31.   Range("F1").Resize(UBound(re), 2) = re
    
32. End Sub

复制代码

跳转到最佳答案楼层

QLZ0602

什么意思？用来干嘛的？
A2 是2 A3 是 5怎么考虑？

xdragon

1. Sub t()
   
2.   Dim arr, i&, line&, sr$, re(), cnt&, j&, k%, m&
   
3.   arr = Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.   ReDim re(1 To UBound(arr), 1 To 2)
   
5.   sr = 258
   
6.   For i = 1 To UBound(arr)
   
7.      If sr Like "*" & arr(i, 1) & "*" Then
   
8.         cnt = cnt + 1
   
9.         sr = Replace(sr, arr(i, 1), "")
   
10.      End If
    
11.      If cnt = 2 Then
    
12.         line = i
    
13.         For j = line + 1 To UBound(arr)
    
14.            For k = 1 To UBound(arr, 2)
    
15.               If CStr(arr(j, k)) = sr Then
    
16.                  re(j, 1) = 0: re(j, 2) = 0
    
17.                  For m = i + 1 To j - 1
    
18.                     re(m, 1) = m - i
    
19.                     re(m, 2) = j - m
    
20.                  Next
    
21.                  sr = 258
    
22.                  cnt = 0
    
23.                  i = j
    
24.                  GoTo nextline
    
25.               End If
    
26.            Next
    
27.         Next
    
28. nextline:
    
29.      End If
    
30.   Next
    
31.   Range("F1").Resize(UBound(re), 2) = re
    
32. End Sub

复制代码

hanjia

xdragon 发表于 2014-8-28 13:02

你好   请再帮我看一下    A到E的数据一换判断出来就错误了  是怎么回事



Microsoft.rar (108.98 KB, 下载次数: 5)

2014-8-28 18:19 上传

点击文件名下载附件

xdragon

你那贴可以关了，哈哈
因为你之前的数据i是连续的，没有不连续的，我就没考虑。。更新了下，你看下行不