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