Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
ссылка на именованный диапазон, как заменить ссылку на именованный диапазон на ссылку на диапазон, куда ссылался именованный диапазон, а потом именованный диапазон удалить
 
#1
01.11.2024 18:02:53
Здравствуйте, в excel книге есть множество именованных диапазонов, которые ссылаются как правило на разные ячейки (как правило на одну ячейку). Причем именованный диапазоны ссылаются на фиксированную формулу.

Есть другие ячейки, которые ссылаются на эти именованные диапазоны.

Мне нужно в ячейках, которые ссылаются на именованные диапазоны:
- чтобы данные ячейки ссылались на фактический диапазон именованного диапазона
- удалить потом именованные диапазоны

Есть ли возможность сделать это как-нибудь не очень сложно.  
 
 
 
#2
01.11.2024 18:25:01
Попробуйте в новый модуль:

Код
Sub ReplaceNamed()
    Dim nm As Name
    Dim ws As Worksheet
    Dim cell As Range
    Dim formulaText As String
    Dim cellAddress As String

    For Each nm In ThisWorkbook.Names
        If Not nm.RefersToRange Is Nothing Then
            cellAddress = nm.RefersToRange.Address(False, False)
            For Each ws In ThisWorkbook.Worksheets
                For Each cell In ws.UsedRange
                    If cell.HasFormula Then
                        formulaText = cell.Formula
                        formulaText = Replace(formulaText, nm.Name, cellAddress)
                        cell.Formula = formulaText
                    End If
                Next cell
            Next ws
        End If
    Next nm
End Sub
Изменено: DAB - 01.11.2024 18:27:17
 
 
 
#3
01.11.2024 19:45:26
Немного позанудствую :)
Советовал бы для начала все имена отсортировать по длине и делать замены от самого длинного к самому короткому.
Зачем. Представим формулу с использованием таких имен:
Код
=ВПР(val;val_table;3;0)
val = $G$1
val_table = $T$1:$AA$1000
А в списке имен сначала будет "val" и только после него "val_table". И когда сначала замените имя "val" на его диапазон, то там, где было имя "val_table" будет уже  $G$1_table:
Код
=ВПР($G$1;$G$1_table;3;0)
понятно, что редко такое внутри одной формулы будет. Но вот то, что короткие имена могут быть частью более длинных - это уже история весьма не редкая.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
02.11.2024 11:51:47
Спасибо, макрос работает в предложенном мной файле примера.

Но у меня оказался более сложный случай. У меня ссылка на именованный диапазон может встречаться многократно на разных страницах книги.
Плюс сами формулы могут состоять из именованных диапазонов (число в одном именованном диапазоне прибавляется к другому именованному диапазону)

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

Так что видимо макрос должен как-то запоминать уникальность имени и его диапазон и потом это проверять.  
 
 
 
#5
02.11.2024 12:06:57
Код
Sub ReplaceNamed()
    Dim nm As Name
    Dim ws As Worksheet
    Dim cell As Range
    Dim formulaText As String
    Dim cellAddress As String

    For Each nm In ThisWorkbook.Names
        If Not nm.RefersToRange Is Nothing Then
            With nm.RefersToRange
                cellAddress = "'" & .Parent.Name & "'!" & .Address(False, False)
            End With
            For Each ws In ThisWorkbook.Worksheets
                For Each cell In ws.UsedRange
                    If cell.HasFormula Then
                        formulaText = cell.Formula
                        formulaText = Replace(formulaText, nm.Name, cellAddress)
                        cell.Formula = formulaText
                    End If
                Next cell
            Next ws
        End If
    Next nm
End Sub
Если, конечно, не будет конфликта имён, описанного в #3.
 
 
 
#6
02.11.2024 13:54:31
Спасибо, на примере это срабатывает.

А вот в моей книге что-то идет не так. Макрос работает, но в итоге не очень вижу какие-то изменения.
Видимо у меня там все перепутано.

В первую очередь выдал мне ошибку про диапазон ссылки - что он не такой как надо.
Попробовал убрать это условием If Not InStr(nm, "NAME?") > 0 Then

при этом имена диапазонов с битыми ссылками визуально не нахожу.  
 
 
 
#7
02.11.2024 14:13:00
Код
Sub ReplaceNamed()
    Dim nm As Name
    Dim ws As Worksheet
    Dim cell As Range
    Dim formulaText As String
    Dim cellAddress As String
    Dim nm_RefersToRange As Range

    For Each nm In ThisWorkbook.Names
        On Error Resume Next
        Set nm_RefersToRange = nm.RefersToRange
        On Error GoTo 0
        If Not nm_RefersToRange Is Nothing Then
            With nm.RefersToRange
                cellAddress = "'" & .Parent.Name & "'!" & .Address(False, False)
            End With
            For Each ws In ThisWorkbook.Worksheets
                For Each cell In ws.UsedRange
                    If cell.HasFormula Then
                        formulaText = cell.Formula
                        formulaText = Replace(formulaText, nm.Name, cellAddress)
                        cell.Formula = formulaText
                    End If
                Next cell
            Next ws
            Set nm_RefersToRange = Nothing
        End If
    Next nm
End Sub
Так будет пропускать эти ссылки.
 
 
 
#8
03.11.2024 12:35:15
Спасибо, кажется, помогло.

Работал макрос долго. Часов 5 - потом уже лег спать и утром он закончил работу. Так что не знаю сколько часов он работал точно.

Но заменил насколько я понимаю все формулы с именованными диапазонами на формулы. Причем каким-то образом оставил и сами именованные диапазоны. Попробую их потом удалить.  
 
 
 
#9
05.11.2024 09:49:47
Код
Sub LittleBitfaster()
    Dim dt As Date
    dt = Now

    Application.ScreenUpdating = False
    Dim Application_Calculation As XlCalculation
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    
    ReplaceNamed
    
    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
    
    Debug.Print Format(Now - dt, "hh:nn:ss")
End Sub

Sub ReplaceNamed()
    Dim nm As Name
    Dim ws As Worksheet
    Dim cell As Range
    Dim formulaText As String
    Dim cellAddress As String
    Dim nm_RefersToRange As Range

    For Each nm In ThisWorkbook.Names
        On Error Resume Next
        Set nm_RefersToRange = nm.RefersToRange
        On Error GoTo 0
        If Not nm_RefersToRange Is Nothing Then
            With nm.RefersToRange
                cellAddress = "'" & .Parent.Name & "'!" & .Address(False, False)
            End With
            For Each ws In ThisWorkbook.Worksheets
                For Each cell In ws.UsedRange
                    If cell.HasFormula Then
                        formulaText = cell.Formula
                        formulaText = Replace(formulaText, nm.Name, cellAddress)
                        cell.Formula = formulaText
                    End If
                Next cell
            Next ws
            Set nm_RefersToRange = Nothing
        End If
    Next nm
End Sub
Цитата
написал:
Работал макрос долго. Часов 5 - потом уже лег спать и утром он закончил работу. Так что не знаю сколько часов он работал точно.
А будет смешно, если достаточно было отключить пересчёт  :D  
 
 
 
Страницы: 1
Наверх