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

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" 项的单元格地址，但是如何 select 来自相邻列 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)
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

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

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 将帮助您 select 从您的结果地址中得到您想要的内容 :

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

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

Find particular data and copy the contents till the row ends

excel

vba

copy

find