Question

我需要构建一个宏来查找工作表1中所需的行，该行由A列中的值预先确定，然后从特定列的同一行中复制值（在此示例中为D:F）进入表2上的预定位置。

不幸的是我不能让宏总是引用相同的单元格，因为数据不会始终从1A开始，它可能从第3行或第10行开始，或者在任何地方开始。列应该每次都保持在同一个地方，但我肯定需要宏来搜索A列中所需的内容。

此外，我不想复制整行，因为表1中的列中有更多数据与表2中所需的内容完全无关。

以下是我需要更好解释的例子：

表1（原始数据）

  |   A   |   B   |   C   |   D   |   E   |   F   |   G   |
--+-------+-------+-------+-------+-------+-------+-------+
1 | Title | M2011 | M2012 | M2013 | M2014 | M2015 |  TTM  |
2 |   1A  |   1B  |   1C  |   1D  |   1E  |   1F  |   1G  |
3 |   2A  |   2B  |   2C  |   2D  |   2E  |   2F  |   2G  |
4 |   3A  |   3B  |   3C  |   3D  |   3E  |   3F  |   3G  | 
5 |   4A  |   4B  |   4C  |   4D  |   4E  |   4F  |   4G  |

表2（期望结果）

  |   A   |   B   |   C   |   D   |  
--+-------+-------+-------+-------+
1 | Title | M2013 | M2014 | M2015 | 
2 |   2A  |   2D  |   2E  |   2F  | 
3 |   4A  |   4D  |   4E  |   4F  | 
4 |   3A  |   3D  |   3E  |   3F  |

Answer 1

以下是一段可以帮助您的代码

Sub SetGrade()

Dim srcSheet As Worksheet
Dim trgtSheet As Worksheet
Dim foundVal As Object
Dim i

Set srcSheet = ThisWorkbook.Sheets(1)
Set trgtSheet = Workbooks("book2").Sheets(1)

For i = 1 To trgtSheet.Cells(trgtSheet.Rows.Count, "A").End(xlUp).Row 'iterate through column A in target sheet

    Set foundVal = srcSheet.Columns(1).Find(srcSheet.Range("a" & i).Value) 'take value from column a target sheet then look for it in column A sourcesheet

    srcSheet.Range(foundVal.Offset(0, 3), foundVal.Offset(0, 5)).Copy Destination:=trgtSheet.Range("B" & i) ' take cells columns D:F from found row and paste them into range starting at column B and row from which search criteria was taken

Next i

End Sub

您需要根据您的情况调整工作簿名称等

Answer 2

我无法弄清楚如何使所提议的公式搜索我需要的内容，所以我最终使用了这个，然后删除它所提取的额外列。不是最高效或最有效的方式，但完成了工作

 Sub DesperateTimes()
    Dim Cell As Range
    For i = 25 To 100
    Sheets("sheet1").Select
    If Cells(i, "A").Value = "Title" Then
    Rows(i).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    End If
    Sheets("sheet1").Select
    If Cells(i, "A").Value = "2A" Then
    Rows(i).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste
    End If
    Sheets("sheet1").Select
    If Cells(i, "A").Value = "4A" Then
    Rows(i).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("A3").Select
    ActiveSheet.Paste
    End If
    Sheets("sheet1").Select
    If Cells(i, "A").Value = "3A" Then
    Rows(i).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("A4").Select
    ActiveSheet.Paste
    End If
    Sheets("sheet2").Select
    Columns("E:EZ").Select
    Selection.ClearContents

    Next i

    End Sub

如何从行中搜索，查找和选择数据并复制到新工作表

2 个答案: