Question

我有一个工作簿，在不同的工作表中有许多命名单元格。我正在尝试编写一个VBA脚本，它将读取外部.csv文件以提取变量名称和变量值，以便我可以更新工作簿中的命名单元格值。

我能够读取并循环CSV文件中的数据，但我无法更新命名值。

理想情况下，脚本会检查变量名是工作簿中的有效命名单元格，然后使用.csv文件中定义的新值进行更新。

我已经进行了多次迭代，但代码的要点是：

Public Sub readCSV()
'
' VBA script to read external CSV file
'
'

Dim filePath As String
Dim inFilePath As String
Dim inCase As String

strWorkBook = ActiveWorkbook.Name
filePath = Range("aString").Value
tmpsep = InStrRev(filePath, "\")

inCase = Right(filePath, Len(filePath) - tmpsep)
inFilePath = Left(filePath, Len(filePath) - Len(inCase))


' Check that path is valid and exit if not
    Range("aString").Select
    If IsEmpty(ActiveCell.Value) Then
        MsgBox "ERROR! No Input File Defined - Exiting!"
        Range("H7").Select
        End
    End If

' Open data file
Workbooks.Open Filename:=filePath


' Loop through variable names in input file
varNamCol = "C"
varColNum = "D"

    ' Ensure we're in input file
    Windows(inCase).Activate

    ' Find last row input file - Call separate routine (working)
    Call FindLastRow.FindLastRow(lRow)

    i = 1
    imax = lRow



    Do While i <= imax
            Windows(inCase).Activate
            ' Read Variable Name and Value from csv
                inVarName = Range(varNamCol & I).Value
                inVarValue = Range(varColNum & I).Value

                If IsEmpty(inVarName) Then
                    MsgBox " Variable is empty - Moving On"
                    GoTo NextIteration
                Else
                   Windows(strWorkBook).Activate
                   Range(inVarName).Value = inVarValue
                End If


        NextIteration:
        i = i + 1
        Loop
End Sub

Answer 1

通过反过来执行操作解决了问题。我没有读取输入卡片并试图在目标工作簿中找到相应的命名范围，而是遍历命名范围并从输入卡片组中找到相应的值。

我还包含了Application.EnableEvents命令，以防止在更新值时激活嵌入的Worksheet_Change宏。

代码是：

Sub tmp()


Dim filePath As String
Dim inFilePath As String
Dim inCase As String

On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False



'----------------------------------
' Find path for input file
    strWorkBook = ActiveWorkbook.Name

    filePath = Range("aString").Value
    tmpsep = InStrRev(filePath, "\")

    ' Input file workbook name
    inCase = Right(filePath, Len(filePath) - tmpsep)
    'Input file full path
    inFilePath = Left(filePath, Len(filePath) - Len(inCase))

' Check that path is valid and exit if not
    Range("aString").Select
    If IsEmpty(ActiveCell.Value) Then
        MsgBox "ERROR! No Input File Defined - Exiting!"
        Range("H7").Select
        End
    End If

' Open input data file
    Workbooks.Open Filename:=filePath

'-------------------------------------



    Dim rFind As Range

' Process to update name values
    Windows(strWorkBook).Activate

    For Each nm In ActiveWorkbook.Names
        varname = nm.Name
        varsheet = Range(nm).Parent.Name
        varcell = nm.RefersToRange.Address(False, False)

        Sheets(varsheet).Select
        Range(varcell).Select

'      Ensure variable in Home and HiddenVariables are not over-written
        If varsheet = "Home" Or varsheet = "HiddenVariables" Then
            GoTo NextIteration
        End If

'      Omit non-user input variables cbelts, anrz, anumhxc, nrotzone

        If varname = "cbelts" Or varname = "anrz" Or varname = "anumhxc" Or varname = "nrotzone" Then
            GoTo NextIteration
        End If

'           Selection.ClearContents

        Windows(inCase).Activate

        ' Find range in inCase that matched varName
            With Range("C:C")
                Set rFind = .Find(What:=varname, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

                If Not rFind Is Nothing Then
                    inCaseRow = rFind.Row
                    updateVal = Range("D" & inCaseRow).Value

                    Windows(strWorkBook).Activate
                    Sheets(varsheet).Select
                    Range(varcell).Value = updateVal
                    Range("D4").Select

                Else
                    Windows(strWorkBook).Activate
                    Range("D4").Select
                End If
            End With


NextIteration:

    Next nm


'  Include routines to populate Porous Media inputs





Application.ScreenUpdating = True

'       Close input case file
        Windows(inCase).Activate
        ActiveWindow.Close

ErrorHandler:
Application.EnableEvents = True


End Sub

更新命名单元格值

1 个答案: