查找特定数据并复制内容直到行结束

Question

我分别维护了两个 Excel 报表EPC1.xlsx 和Control Power Transformers.xlsm。

我想触发来自Control Power Transformers.xlsm 报告的按钮单击，它将在EPC1.xlsx 的“A”列中搜索"CTPT" 术语，一旦找到需要复制B 列和c 列的术语，直到行结束（在EPC1.xlsx 中）并将其粘贴到Control Power Transformers.xlsm 工作簿中

我成功检索到“CTPT”术语的单元格地址，但是如何从相邻的 B 列和 C 列中选择数据？

这是我尝试过的

Private Sub CommandButton23_Click()
Dim rngX As Range
Dim num As String

Windows("EPC 1.xlsx").Activate
Set rngX = Worksheets("Sheet1").Range("A1:A10000").Find("CTPT", Lookat:=xlPart)
num = rngX.Address ' Here we will the get the cell address of CTPT ($A$14)
Range(rngX, Range("C" & rngX.Row).End(xlDown)).Copy
Windows("Control Power Transformers.xlsm").Activate
Sheets("Sheet2").Select
ActiveSheet.Range("E2").PasteSpecial (xlPasteValues)


End Sub

Answer 1

将以下内容粘贴到示例工作簿中。下面的代码将有助于使用文件对话框选择这两个文件。它将搜索单词“CTPT”。如果是这样，它会将列值从 CTPT 表复制到控制文件。

Sub DetailsFilePath()

Dim File1 As String
Dim File2 As String
Dim findtext As String
Dim copyvalues As Long
Dim c As Variant

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet

MsgBox "Open the CTPT file"

Application.FileDialog(msoFileDialogFilePicker).Show


'On Error Resume Next

' open the file

File1 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

MsgBox "Open the Control Power Transformers file"


Application.FileDialog(msoFileDialogFilePicker).Show

File2 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)




Set wb1 = Workbooks.Open(Filename:=File1)
Set ws1 = wb1.Worksheets("sheet1")


Set wb2 = Workbooks.Open(Filename:=File2)
Set ws2 = wb2.Worksheets("sheet1")




findtext = "CTPT"

   With ws1.Columns(1)
        Set c = .Find(findtext, LookIn:=xlValues)
            If Not c Is Nothing Then
                copyvalues = c.Column
            ws2.Columns(2).Value = ws1.Columns(2).Value
            ws2.Columns(3).Value = ws1.Columns(3).Value


             End If
    End With


wb1.Close savechanges:=True
wb2.Close savechanges:=True



End Sub

Answer 2

您需要使用FindNext 查找其他结果，Offset 将帮助您从结果地址中选择您想要的内容：

Sub test_Karthik()
Dim WbEPC As Workbook, _
    WbCPT As Workbook, _
    WsEPC As Worksheet, _
    WsCPT As Worksheet, _
    FirstAddress As String, _
    WriteRow As Long, _
    cF As Range, _
    num As String

Set WbEPC = Workbooks("EPC 1.xlsx")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet2")

With WsEPC
    .Activate
    With .Range("A1:A10000")
    'First, define properly the Find method
        Set cF = .Find(What:="CTPT", _
                    After:=ActiveCell, _
                    LookIn:=xlValues, _
                    Lookat:=xlPart, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)

        'If there is a result, keep looking with FindNext method
        If Not cF Is Nothing Then
            FirstAddress = cF.Address
            Do
                num = cF.Address ' Here we will the get the cell address of CTPT ($A$14)
                WsEPC.Range(cF.Offset(0, 1), cF.Offset(0, 2).End(xlDown)).Copy
                WriteRow = WsCPT.Range("E" & WsCPT.Rows.count).End(xlUp).Row + 1
                WsCPT.Range("E" & WriteRow).PasteSpecial (xlPasteValues)

                Set cF = .FindNext(cF)
            'Look until you find again the first result
            Loop While Not cF Is Nothing And cF.Address <> FirstAddress
        End If
    End With
End With

End Sub