VBA如何将满足条件的内容复制到另一列,求懂编程的大神帮帮忙!!跪求!!

VBA如何将满足条件的内容复制到另一列,求懂编程的大神帮帮忙!!跪求!!,第1张

满足你要求的VBA代码如下:

Option Explicit

Sub 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)

数组公式


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/sjk/10001040.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-04
下一篇 2023-05-04

发表评论

登录后才能评论

评论列表(0条)

保存