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

Question

我需要帮助定义我的复制/粘贴过程。我只需要一个例子来说明这两种情况。情况如下:

我需要在一张 wb1 和
在某些条件下将其复制/粘贴到 wb2。

我不知 Prop 体的工作表或关键字的位置，所以
应检查 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。所以，每张纸都应该根据设置检查
关键字。

例子:

https://imgur.com/a/8VCNsrC

将不胜感激任何帮助!

到目前为止的代码 - 我唯一需要的是条件 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