[Excel+VBA]如何查找某个表格里的数据并将相关数据复制到另一个表中的相应列中?

[Excel+VBA]如何查找某个表格里的数据并将相关数据复制到另一个表中的相应列中?,第1张

用函数也可以

数组公式

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

数组公式

以下是可以实现上述条件的示例代码:

Sub CopyData()

Dim i As Integer, j As Integer, lastRow As Integer, targetSheet As Worksheet

javaCopy codelastRow = Cells(Rows.Count, "H").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 8).Value = 4 Then

If Cells(i + 1, 8).Value >= 5 And Cells(i + 2, 8).Value <= 4 ThenSet targetSheet = Worksheets("A")

targetSheet.Range("F" &targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 &":H" &targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2).Value = Range("F" &i &":H" &i + 2).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "L").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 12).Value = 4 Then

If Cells(i + 1, 12).Value >= 5 And Cells(i + 2, 12).Value >= 5 And Cells(i + 3, 12).Value <= 4 ThenSet targetSheet = Worksheets("B")

targetSheet.Range("J" &targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 &":L" &targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 3).Value = Range("J" &i &":L" &i + 3).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "P").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 16).Value = 4 Then

If Cells(i + 1, 16).Value >= 5 And Cells(i + 2, 16).Value >= 5 And Cells(i + 3, 16).Value >= 5 And Cells(i + 4, 16).Value <= 4 ThenSet targetSheet = Worksheets("C")

targetSheet.Range("N" &targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1 &":P" &targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 4).Value = Range("N" &i &":P" &i + 4).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "T").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 20).Value = 4 Then

If Cells(i + 1, 20).Value >= 5 And Cells(i + 2, 20).Value >= 5 And Cells(i + 3, 20).Value >= 5 And Cells(i + 4, 20).Value >= 5 And Cells(i + 5, 20).Value <= 4 ThenSet targetSheet = Worksheets("D")

targetSheet


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

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

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

发表评论

登录后才能评论

评论列表(0条)

保存