Excel 2016 VBA 宏 - 使用存储在另一个工作簿中的值更新 Excel 工作簿中的各种命名范围

Question

任务是使用存储在“源”工作簿中的值更新“模型”工作簿中的几个不同命名范围。 “源”工作簿有几列信息，但只有 3 列（“命名范围”、“字符串”、“值”）包含要更新的数据。这 3 列也构成了命名范围“例外”。

应该发生的是提示用户输入与他们想要推送到“模型”工作簿的“例外”相关的开始和结束行号。这个想法是“例外”的“命名范围”列存储“字符串”和“值”中的值应该在“模型”中的相应位置的命名范围。此外，宏应该检查“字符串”是否已经存在于“模型”的“命名范围”的第一列中。如果不是，那么宏应该在“模型”中“命名范围”的末尾粘贴“字符串”和“值”（并最终扩展命名范围以包含新添加的内容）。

下面的代码没有运行。我尝试用静态值替换 Riderrange.Range(___) 引用并且代码有效，但结果是“字符串”没有粘贴在命名范围的末尾。

在用户在“Source”中选择的行中，可能有多个相同的“Named Range”，那么按照“Named Range”的顺序更新“Model”会更高效吗？

我在 Windows 上使用 Excel 2016。

Sub BaseSheetUpdate()

Dim startrow As Integer
Dim endrow As Integer
Dim Model As Workbook
Dim Source As Workbook
Dim riderrange As Range

Set Source = ThisWorkbook

Set Model = Workbooks.Open(Filename, _
        ReadOnly:=False, _
        UpdateLinks:=False)

startrow = InputBox("Enter Starting Row Number: ")
endrow = InputBox("Enter Last Row Number: ")

For i = 1 To (endrow - startrow + 1)

Set riderrange = Source.Worksheets("Sheet1").Range("ExceptionsUpdate") _
            .Range("A" & startrow + i - 1 & ":C" & startrow + i - 1)

With Model.Worksheets("Base").Range(riderrange.Range("A" & i).Value).Columns(1)

Set cell = Selection.Find(What:=riderrange.Range("B" & i).Value, LookIn:=xlValues)

If cell Is Nothing Then

.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Value = riderrange.Range("B" & i & ":C" & i)

Else
    'If any of the "String"s already exists in the named range, the goal is to store the "String"s in a list and print a message to the user at the end saying "These strings already exist in the model."

End If

End With

Next i

End Sub

Answer 1

我想出了一个解决方案并更新了要分享的代码。如果您看到任何整合或改进的机会，请告诉我。谢谢

Sub BaseSheetUpdate()

Dim startrow As Integer
Dim endrow As Integer
Dim Model As Workbook
Dim Source As Workbook
Dim riderrange As Range
Dim BSK As Variant

Set Source = ThisWorkbook

Set Model = Workbooks.Open(Filename, _
        ReadOnly:=False, _
        UpdateLinks:=False)

startrow = InputBox("Enter Starting Row Number: ")
endrow = InputBox("Enter Last Row Number: ")

For i = 1 To (endrow - startrow + 1)

Set riderrange = Source.Worksheets("Sheet1").Range("ExceptionsUpdate") _
            .Range("A" & startrow + i - 1 & ":C" & startrow + i - 1)

With Model.Worksheets("Sheet1").Range(riderrange.Range("A1"))

    .Select

        Set cell = Selection.Find(What:=riderrange.Range("B1"), LookIn:=xlValues)

        'If the BSK isn't in the named range, then the BSK and value are pasted at the end of the named range in the model

        If cell Is Nothing Then

            .End(xlDown).Offset(1, 0).Value = riderrange.Range("B1")
            .End(xlDown).Offset(0, 1).Value = riderrange.Range("C1")

        Else

            'If the BSK already exists in Sheet1, then the BSK is saved to the BSK variable for reporting at the end of the loop.

            BSK = BSK & vbCrLf & riderrange.Range("B1").Value

        End If

    End With

End If

Next i

MsgBox "Model update complete."

'Any BSK's that aren't updated will be displayed in a messagebox to the user.

If BSK > 0 Then

MsgBox "The following BSK's were not added:" & vbCrLf & BSK, vbExclamation, "DANGER! DANGER!"

Else
Workbooks(Model).Close SaveChanges:=True
End If

End Sub