Question

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

应该发生的是提示用户输入相对于＆＃34; Exceptions＆＃34;的开始和结束行号。他们想要推动'＃34;模型＆＃34;工作簿。这个想法是＆＃34;命名范围＆＃34;专栏＆＃34;例外＆＃34;存储相应位置的命名范围，其中值为＆＃34; String＆＃34;和＆＃34;价值＆＃34;应该进入＆＃34;模型＆＃34;。另外，宏应该检查＆＃34; String＆＃34;已存在于＆＃34;命名范围的第一列＆＃34; ＆＃34;模型＆＃34;。如果没有，那么宏应该粘贴＆＃34; String＆＃34;和＆＃34;价值＆＃34;在＆＃34;命名范围的末尾＆＃34;在＆＃34;模型＆＃34; （并最终扩展命名范围以包括新增加的内容）。

以下代码无法运行。我尝试用静态值替换riderrange.Range（___）引用并且代码有效，但结果是＆＃34; String＆＃34;没有粘贴在指定范围的末尾。

在用户在＆＃34; Source＆＃34;中选择的行中，可能有几个相同的＆＃34;命名范围＆＃34;，因此更新＆＃34;模型＆＃34;按照＆＃34;命名范围＆＃34; s？

的顺序

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

Excel 2016 VBA宏 - 使用存储在另一个工作簿中的值

1 个答案: