Обновить значения именованных ячеек - PullRequest
0 голосов
/ 29 мая 2018

У меня есть рабочая тетрадь со многими именованными ячейками на разных листах.Я пытаюсь написать сценарий 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

1 Ответ

0 голосов
/ 31 мая 2018

Проблема устранена путем выполнения операций наоборот.Вместо того чтобы читать входную деку и пытаться найти соответствующий именованный диапазон в целевой книге, я перебираю именованные диапазоны и нахожу соответствующие значения из входной колоды.

Я также включил команды 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...