Question

我想运行代码，将从其他源工作簿（保存在我的电脑上）中提取数据到我需要更新的当前工作簿。这意味着我需要使用2个工作簿（我当前的工作簿和另一个源工作簿），但不应打开源工作簿，而只应通过其路径名引用，以便从中复制数据。我找到了类似的主题，一切都会正常工作，除了我需要一个条件，可以将数据从另一个工作簿复制到我当前的工作簿。

我在当前工作簿中有一个已定义的名称，并且我希望代码仅在源工作簿的某个列中找到已定义的名称（在当前工作簿中定义）时才从另一个源工作簿复制数据（此处没有名称）定义）。为了使它更加可怕，源工作簿的特定列中需要与当前工作簿中的定义名称匹配的值也必须仅根据左侧的前18个字符对齐，其余的可以不同。因此，如果在源工作簿的此特定列中，前18个字符与我当前工作簿中的“我定义的名称”不同，则不应复制数据。我当前工作簿中我希望粘贴数据的工作表称为“测试”。然而，每当我从中复制数据时，源工作簿都有随机名称，并且它只有一个名为'Sheet1'的标准工作表，从中复制数据（这就是为什么我希望它被路径调用）仅限名称。

我非常感谢有关编写此条件的帮助，打开源工作簿（没有实际打开它）的条款和我当前工作簿中的应对数据工作正常，但我正在混合条件。

以下是我正在使用的代码（在声明'Else'之后一切正常）：

Sub Copy_Data()

    Dim ActiveArray As Variant
    Dim SourceWBpath As Variant
    Dim i As Long
    endRow = 1003
    Const l_MyDefinedName As String = "MyDefinedName"
    Const s_ColumnToMatch As String = "N:N"   'The column in Source Workbook to be match with My defined name

    Application.ScreenUpdating = False

    Set ActiveArray = ActiveWorkbook
    Set SourceWBpath = Worksheets("Test").Range("E1")      'Cell with path to the Source Workbook
    Set SourceWB = Workbooks.Open(SourceWBpath)
    Set MyWorkbook = ThisWorkbook.Worksheets("Test")

 '**************************Copy Workbook content to this sheet****************************************************
    For i = 5 To endRow
        With SourceWB.Worksheets("Sheet1").Range(s_ColumnToMatch)
            Dim strCellValue As String: strCellValue.Value2  'This is supposed to look up the values in SOurce WOrkbook in column N:N and match with Mydefined Name
                If SourceWBpath= "" And Left(strCellValue, Len(Range("MyDefinedName").Value2)) <> MyWorkbook.Range("MyDefinedName").Value2 Then

                    Else
                    Workbooks.Open SourceWBpath, local:=True
                    Range("A2:Y1900").Copy
                    ActiveArray.Sheets("Test").Range("A5").PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    ActiveWorkbook.Close
                End If
        End With
    Next i
End Sub

我知道代码中缺少的一件事就是声明另一个变量，例如：定义'strCellValue'的i2应该只根据左边的18个第一个字符匹配。我认为它应该是这样的：

i2 = InStr(1, strCellValue, Chr(18))

问题在于我不确定它应该放在哪里。

我将非常感谢一些提示。

Answer 1

我会选择

Dim rngFound as Range
On Error Resume Next
set rngFound = SourceWB.Worksheets("Sheet1").Range(s_ColumnToMatch).Find(What:=l_myDefinedName & "*", LookAt:=xlWhole)
ON error goto 0
If Not rngFound IS Nothing then
rngfound.currentRegion.Copy ActiveArray.Sheets("Test").Range("A5")
End If

我假设您可以使用CurrentRegion选择源文件数据。如果没有，你可以坚持你的范围选择，但我会选择rngFound.Parent.Range("A2:Y1900").Copy

将数据从源工作簿复制到我当前的工作簿，条件是匹配定义的名称

1 个答案: