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

Question

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

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

下面的代码无法运行。 我尝试用静态值替换riderrange.Range（___）引用，并且代码可以运行，但是结果是“ String”没有粘贴在命名范围的末尾。

在用户在“源”中选择的行中，可能会有多个相同的“命名范围”，那么按“命名范围”的顺序更新“模型”会更有效吗？

我正在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