Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перевод формулы гиперссылки с условием на макрос - Страница 2 - Мир MS Excel

Старая форма входа
  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: китин, _Boroda_  
Перевод формулы гиперссылки с условием на макрос
Nic70y Дата: Вторник, 23.05.2023, 11:44 | Сообщение № 21
Группа: Друзья
Ранг: Экселист
Сообщений: 8831
Репутация: 2300 ±
Замечаний: 0% ±

Excel 2010
см. такой вариант
исправите на нужные столбцы
[vba]
Код
Sub u_700()
    For a = 1 To Sheets.Count 'пройдемся по листам
        If a <> 2 Then 'если лист не второй
            If a = 1 Then 'если это первый лист
                s = "b" 'проверяемый столбец
                t = "j" 'столбец для гиперссылки
            Else 'другие листы
                s = "a" 'проверяемый столбец
                t = "g" 'столбец для гиперссылки
            End If
            u = Sheets(a).Cells(Rows.Count, s).End(xlUp).Row
            If u > 1 Then
                For v = 2 To u
                    If Sheets(a).Range(s & v) <> "" Then
                        Sheets(a).Hyperlinks.Add Anchor:=Sheets(a).Range(t & v), Address:="#", _
                            SubAddress:="Пункт!A2", TextToDisplay:="Пункт!"
                    Else
                        Sheets(a).Range(t & v).ClearContents
                    End If
                Next
            End If
        End If
    Next
    '=ДВССЫЛ("'"&B2&"'!E"&СТРОКА()-ПОИСКПОЗ(B2;B$2:B2;)+1)&""
    x = Cells(Rows.Count, "b").End(xlUp).Row
    Range("g2:g" & x).Formula = "=INDIRECT(""'""&B2&""'!E""&ROW()-MATCH(B2,B$2:B2,)+1)&"""""
    Range("g2:g" & x) = Range("g2:g" & x).Value
End Sub
[/vba]
К сообщению приложен файл: 259.xlsm (23.4 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 23.05.2023, 11:47
 
Ответить
Сообщениесм. такой вариант
исправите на нужные столбцы
[vba]
Код
Sub u_700()
    For a = 1 To Sheets.Count 'пройдемся по листам
        If a <> 2 Then 'если лист не второй
            If a = 1 Then 'если это первый лист
                s = "b" 'проверяемый столбец
                t = "j" 'столбец для гиперссылки
            Else 'другие листы
                s = "a" 'проверяемый столбец
                t = "g" 'столбец для гиперссылки
            End If
            u = Sheets(a).Cells(Rows.Count, s).End(xlUp).Row
            If u > 1 Then
                For v = 2 To u
                    If Sheets(a).Range(s & v) <> "" Then
                        Sheets(a).Hyperlinks.Add Anchor:=Sheets(a).Range(t & v), Address:="#", _
                            SubAddress:="Пункт!A2", TextToDisplay:="Пункт!"
                    Else
                        Sheets(a).Range(t & v).ClearContents
                    End If
                Next
            End If
        End If
    Next
    '=ДВССЫЛ("'"&B2&"'!E"&СТРОКА()-ПОИСКПОЗ(B2;B$2:B2;)+1)&""
    x = Cells(Rows.Count, "b").End(xlUp).Row
    Range("g2:g" & x).Formula = "=INDIRECT(""'""&B2&""'!E""&ROW()-MATCH(B2,B$2:B2,)+1)&"""""
    Range("g2:g" & x) = Range("g2:g" & x).Value
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 23.05.2023 в 11:44
flywithme1299 Дата: Вторник, 23.05.2023, 13:17 | Сообщение № 22
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 20% ±

EXCEL 2013
Nic70y, Классно, ссылки работают, только таки не решилась проблема с ДВССЫЛ, ох не могу понять, что не нравится, либо так на фамилию реагирует, либо, что
 
Ответить
СообщениеNic70y, Классно, ссылки работают, только таки не решилась проблема с ДВССЫЛ, ох не могу понять, что не нравится, либо так на фамилию реагирует, либо, что

Автор - flywithme1299
Дата добавления - 23.05.2023 в 13:17
Nic70y Дата: Вторник, 23.05.2023, 13:25 | Сообщение № 23
Группа: Друзья
Ранг: Экселист
Сообщений: 8831
Репутация: 2300 ±
Замечаний: 0% ±

Excel 2010
так на фамилию реагирует

возможно.
фамилия и имя листа должны точно совпадать.


ЮMoney 41001841029809
 
Ответить
Сообщение
так на фамилию реагирует

возможно.
фамилия и имя листа должны точно совпадать.

Автор - Nic70y
Дата добавления - 23.05.2023 в 13:25
flywithme1299 Дата: Вторник, 23.05.2023, 13:39 | Сообщение № 24
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 20% ±

EXCEL 2013
Nic70y, проверил, первый раз сработало, второй раз не хочет, при чем не срабаывает на одну фамилию, на другие без проблем, ох сижу уже неделю с этим


Сообщение отредактировал flywithme1299 - Вторник, 23.05.2023, 13:42
 
Ответить
СообщениеNic70y, проверил, первый раз сработало, второй раз не хочет, при чем не срабаывает на одну фамилию, на другие без проблем, ох сижу уже неделю с этим

Автор - flywithme1299
Дата добавления - 23.05.2023 в 13:39
Nic70y Дата: Вторник, 23.05.2023, 14:02 | Сообщение № 25
Группа: Друзья
Ранг: Экселист
Сообщений: 8831
Репутация: 2300 ±
Замечаний: 0% ±

Excel 2010
файл с этой фамилией можете приложить?


ЮMoney 41001841029809
 
Ответить
Сообщениефайл с этой фамилией можете приложить?

Автор - Nic70y
Дата добавления - 23.05.2023 в 14:02
flywithme1299 Дата: Вторник, 23.05.2023, 14:07 | Сообщение № 26
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 20% ±

EXCEL 2013
Nic70y, к сожалению, публично не могу
 
Ответить
СообщениеNic70y, к сожалению, публично не могу

Автор - flywithme1299
Дата добавления - 23.05.2023 в 14:07
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!