满足你要求的VBA代码如下:
Option ExplicitSub YgB()
Dim i, j, x1, x2, i2, n
x1 = Cells(3, "N")
x2 = Cells(4, "N")
i2 = 2 '下一个保存结果的行
For i = 4 To Cells(65536, "K").End(xlUp).Row
If Cells(i - 2, "K") = x1 And Cells(i - 1, "K") = x2 Then
n = 0 '复制个数
For j = 1 To 10
If Cells(i, j + 1) = x2 Then
n = n + 1
Cells(i2, j + 15) = x2
End If
Next j
If n <> 0 Then i2 = i2 + 1
End If
Next i
End Sub
用函数也可以数组公式
=INDEX(三角网原始数据!A:A,SMALL(IF(ISNUMBER(FIND("编号",三角网原始数据!$A$1:$A$100)),ROW(三角网原始数据!$A$1:$A$100),65536),ROW(A1)))&""
同时按CTRL SHFIT 回车键
出现结果,下拉公式
第3列同理
VBA的要依次循环包含了 编号或 挖方的数据
或设置 步长
复制到 sheet1表
Sub 编号()
Dim i, n
n = 2
For i = 1 To Sheets("三角网原始数据").Range("a65536").End(xlUp).Row Step 6
n = n + 1
Cells(n, "a") = Sheets("三角网原始数据").Cells(i, "A")
Cells(n, "C") = Sheets("三角网原始数据").Cells(i + 4, "A")
Next
End Sub
A3=RIGHT(INDEX(三角网原始数据!A:A,SMALL(IF(ISNUMBER(FIND("编号",三角网原始数据!$A$1:$A$100)),ROW(三角网原始数据!$A$1:$A$100),65536),ROW(A1)))&"",LEN(INDEX(三角网原始数据!A:A,SMALL(IF(ISNUMBER(FIND("编号",三角网原始数据!$A$1:$A$100)),ROW(三角网原始数据!$A$1:$A$100),65536),ROW(A1)))&"")-3)
C3=MID(INDEX(三角网原始数据!A:A,SMALL(IF(ISNUMBER(FIND("挖方",三角网原始数据!$A$1:$A$100)),ROW(三角网原始数据!$A$1:$A$100),65536),ROW(A1)))&"",4,FIND("填方",INDEX(三角网原始数据!A:A,SMALL(IF(ISNUMBER(FIND("挖方",三角网原始数据!$A$1:$A$100)),ROW(三角网原始数据!$A$1:$A$100),65536),ROW(A1)))&"")-5)
数组公式
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)