Question

我需要定义复制/粘贴过程的帮助。对于这两个条件，我只需要一个示例。情况如下：

我需要在一张wb1中搜索特定的关键字，然后在特定条件下将其复制/粘贴到wb2。
我不知道具体的工作表或关键字的位置，因此 wb中的每张纸都应检查
如果找到了关键字-条件1或条件2将为应用，具体取决于关键字：
条件1：如果wb1中的关键字=“ mx1”，则将关键字复制/粘贴到wb2中（特定位置-> Sheet2，K7）并将其重命名为“ Male”。结果在wb2中Sheet2的K7中为“男性”。
条件2：如果wb1中的关键字=“数据1”，则复制相邻单元格右边的值（整数）并粘贴到 wb2（特定位置-> Sheet3，K3）。结果将是：K7中为“ 189” wb2中Sheet3的内容。
关键字只能分配一个条件。

实际上，我的目标是拥有一组具有条件的关键字 1或条件2，以及在中的特定粘贴位置 wb2。因此，应根据以下条件检查每张纸关键字。

示例：

不胜感激！

到目前为止，代码-我只需要条件1和2。...

Public Sub TransferFile(TemplateFile As String, SourceFile As String)
    Dim wbSource As Workbook
    Set wbSource = Workbooks.Open(SourceFile) 'open source

    Dim rFnd As Range
    Dim r1st As Range
    Dim ws As Worksheet
    Dim arr(1 To 2) As Variant
    Dim i As Long

    Dim wbTemplate As Workbook
    Dim NewWbName As String

    Dim wsSource As Worksheet
    For Each wsSource In wbSource.Worksheets 'loop through all worksheets in source workbook
        Set wbTemplate = Workbooks.Open(TemplateFile) 'open new template

        '/* Definition of the value range */

arr(1) = "mx1"
arr(2) = "Data 1"
For i = LBound(arr) To UBound(arr)
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name
        Set rFnd = ws.UsedRange.Find(what:=arr(i), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlRows, _
                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not rFnd Is Nothing Then
            Set r1st = rFnd
            Do
                If i = 1 Then
                    wb2.Sheets("Sheet1").Range("A3").Value = "Male"
                Else
                    wb2.Sheets("Sheet1").Range("B3").Value = rFnd.Offset(0, 1).Value
                End If
                Set rFnd = ws.UsedRange.FindNext(rFnd)
            Loop Until r1st.Address = rFnd.Address
        End If
    Next
Next

        NewWbName = Left(wbSource.Name, InStr(wbSource.Name, ".") - 1)
        wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName & "_New.xlsx"
        wbTemplate.Close False 'close template
    Next wsSource

    wbSource.Close False 'close source
End Sub

Answer 1

您可以在Range中搜索值，并且范围适用于单张纸（的一部分）。因此，您需要分别搜索每个工作表。同样，您搜索单个值，因此在这种情况下，您需要发出2个单独的搜索。我会这样：

Dim rFnd As Range
Dim r1st As Range
Dim ws As Worksheet
Dim arr(1 to 2) As Variant
Dim i as Long

arr(1) = "mx1"
arr(2) = "Data 1"
For i = Lbound(arr) to Ubound(arr)
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name
        Set rFnd = ws.UsedRange.Find(what:=arr(i), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlRows, _
                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not rFnd Is Nothing Then
            Set r1st = rFnd
            Do
                If i = 1 then
                    wb2.Sheets("Sheet2").Range("K7").Value = "Male"
                Else
                    wb2.Sheets("Sheet3").Range("K3").Value = rFnd.Offset(0, 1).Value
                End If
                Set rFnd = ws.UsedRange.FindNext(rFnd)
            Loop Until r1st.Address = rFnd.Address
        End If
    Next
Next

确定复制/粘贴过程的范围/条件

1 个答案: