Ссылки на другие ячейки в таблице - Страница 2 - Мир MS Excel

Регистрация

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

= Мир MS Excel/Ссылки на другие ячейки в таблице - Страница 2 - Мир MS Excel

Старая форма входа

Страница 2 из 2 « 1 2
Модератор форума: китин, _Boroda_

Ссылки на другие ячейки в таблице

Ссылки на другие ячейки в таблице

Дата: Вторник, 06.12.2011, 23:24 | Сообщение № 21

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Елена, Вы верно поняли, менять адреса только тут.
Но, если будут меняться списки турниров в ширину, т.е. двигаться колонки, то ещё нужно подкорректировать цифры в строке
[vba]

Код

a(i, 1), Left(a(i, 1) & " ", 4) & Left(a(i, 16) & " ", 10) & a(i, 2)

[/vba]
Аналогично и для массива b.
1, 2 и 16 - это номера колонок этих массивов/диапазонов.
1 - номер
2 - название турнира
16 - месяц

Ну и если будет меняться расположение номеров верхней части таблицы (по которым в начале кликали), то нужно править цифры тут:
[vba]

Код

For Each cc In Range(Cells(Target.Row, 14), Cells(Target.Row, 40))

[/vba]
и аналогично в строке ниже для второго года.

А вообще лучше было бы как у RAN эти таблицы на отдельных листах держать - и просматривать/править удобнее, и менять потом проще - переименовал или подвинул лист и всё, смотря как в коде обращение к ним прописать.
И легко архив хоть за 20 лет держать - старые листы можно просто скрыть, чтоб не мешались, если напрягают.

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Среда, 07.12.2011, 00:10 | Сообщение № 22

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

RAN Вы молодец и наверное это отличное решение, но только под решение Hugo уже все переделали а скачать не можем: http://www.excelworld.ru/_fr/10/-rating-NEW1-Hu.rar (Невозможно найти ресурс)
По фамилии и имени это правильнее (для нас - убедились) и хранить более 2-х лет нет необходимости.
Если игрок становится профи - данные по нему есть на международных сайтах. А если нет, то информация устаревает и старые турниры
для изучения не нужны.
Спасибо и ждем -rating-NEW1-Hu.rar от Hugo
RAN вы классный специалист. tongue

tongue

Ответить

Дата: Среда, 07.12.2011, 18:01 | Сообщение № 23

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Hugo Я все поправила вручную, как Вы описали - Все работает ОК.
Так, что файл можно и не слать. Если только в этом отличие.

Ответить

Дата: Среда, 07.12.2011, 18:17 | Сообщение № 24

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Вот исправленный вариант.
(Тему немного почистил)

К сообщению приложен файл: _v2.rar (42.6 Kb)

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Среда, 07.12.2011, 23:06 | Сообщение № 25

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Добрый вечер Hugo
А там в новом файле только то,о чем Вы писали в Сообщении № 18
Я сама поправила то, о чем писали Вы в этом сообщении и все стало ОК.
или что-то еще?
Уже начинаю собой беспочвенно гордиться после Сообщение № 21
Что я все верно поняла.

Ответить

Дата: Среда, 07.12.2011, 23:22 | Сообщение № 26

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Вы молодец smile

smile

Да, там в файле никаких других изменений нет.

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Воскресенье, 11.12.2011, 17:14 | Сообщение № 27

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Все отлично Hugo, но настоящий молодец это ВЫ !!!
В этом файле остался у меня только один вопрос - он более информативный и очень маленький, чем принципиальный но боюсь меня заругают, т.к. тема немного другая.

Сейчас создам тему...

Ответить

Дата: Четверг, 29.12.2011, 01:52 | Сообщение № 28

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Здравствуйте Hugo! Попыталась сделать заготовку этого-же файла на новый год и поняла, что я-дуреха опять не могу ни с чем справиться самостоятельно.
Тут всего вроде уменьшилось кол-во ячеек в турнирах 2012 года и перенеслась колонка месяц в этом же годе. (она теперь 13 по номеру, а не 16),
ну и поменялись местами турниры 2012 года (возникли) и 2011 встали на место 2010.
Вроде все подправила, а двойной клик выдает ошибку. Не могу понять в чем дело.
Что-то очень простое, а что мне не ведомо.

С наступающим Новым годом всех, кто мне помогал или пытался помогать или слегка поругивал. Желаю всяческих удач Вам , здоровья Вам и Вашим близким, успехов в профессиональном и карьерном росте , любви, радости и хорошего настроения !

К сообщению приложен файл: _Rating.rar (66.9 Kb)

Ответить

Дата: Четверг, 29.12.2011, 02:27 | Сообщение № 29

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Здравствуйте smile

smile

Вроде бы так - но проверьте тщательно.
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      If Not Intersect(Target, [D2:D11]) Is Nothing Then
          Dim a(), b(), i&, cc As Range, flag As Boolean, x&
          Dim g1$, g2$

          'заголовки списка турниров для листбокса берутся с листа из этих ячеек!!!
          g1 = [Y12]
          g2 = [AW12]

          'берём в массивы списки турниров
          a = Range(Cells(14, "AC"), Cells(Rows.Count, "N").End(xlUp)).Value
          b = Range(Cells(14, "BA"), Cells(Rows.Count, "AO").End(xlUp)).Value

          'заносим в словарь номера турниров (с заголовком списка турниров впереди)
          'в Item словаря помещаем данные турнира, для красоты месяцу добавляем пробелы
          With CreateObject("Scripting.Dictionary")
              .CompareMode = vbTextCompare
              For i = 1 To UBound(a)
                  .Add g1 & "|" & a(i, 1), Left(a(i, 1) & "    ", 4) & Left(a(i, 13) & "          ", 10) & a(i, 2)
              Next
              For i = 1 To UBound(b)
                  .Add g2 & "|" & b(i, 1), Left(b(i, 1) & "    ", 4) & Left(b(i, 13) & "          ", 10) & b(i, 2)
              Next

              'заносим данные из словаря в массив для листбокса
              ReDim c(0)

              'перебираем строку 2012 года
              For Each cc In Range(Cells(Target.Row, 21), Cells(Target.Row, 40))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g1 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then
                  c(0) = g1
                  flag = False
                  ReDim Preserve c(UBound(c) + 1)
                  x = UBound(c)
              End If

              'перебираем строку 2011 года
              For Each cc In Range(Cells(Target.Row, 41), Cells(Target.Row, 58))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g2 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then c(x) = g2

          End With

          'фамили для заголовка формы
          fam = Cells(Target.Row, 4)
          Cancel = True
          UserForm1.Show

      End If
End Sub

[/vba]

Спасибо за поздравления! smile

smile

Здравствуйте smile

smile

Вроде бы так - но проверьте тщательно.
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      If Not Intersect(Target, [D2:D11]) Is Nothing Then
          Dim a(), b(), i&, cc As Range, flag As Boolean, x&
          Dim g1$, g2$

          'заголовки списка турниров для листбокса берутся с листа из этих ячеек!!!
          g1 = [Y12]
          g2 = [AW12]

          'берём в массивы списки турниров
          a = Range(Cells(14, "AC"), Cells(Rows.Count, "N").End(xlUp)).Value
          b = Range(Cells(14, "BA"), Cells(Rows.Count, "AO").End(xlUp)).Value

          'заносим в словарь номера турниров (с заголовком списка турниров впереди)
          'в Item словаря помещаем данные турнира, для красоты месяцу добавляем пробелы
          With CreateObject("Scripting.Dictionary")
              .CompareMode = vbTextCompare
              For i = 1 To UBound(a)
                  .Add g1 & "|" & a(i, 1), Left(a(i, 1) & "    ", 4) & Left(a(i, 13) & "          ", 10) & a(i, 2)
              Next
              For i = 1 To UBound(b)
                  .Add g2 & "|" & b(i, 1), Left(b(i, 1) & "    ", 4) & Left(b(i, 13) & "          ", 10) & b(i, 2)
              Next

              'заносим данные из словаря в массив для листбокса
              ReDim c(0)

              'перебираем строку 2012 года
              For Each cc In Range(Cells(Target.Row, 21), Cells(Target.Row, 40))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g1 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then
                  c(0) = g1
                  flag = False
                  ReDim Preserve c(UBound(c) + 1)
                  x = UBound(c)
              End If

              'перебираем строку 2011 года
              For Each cc In Range(Cells(Target.Row, 41), Cells(Target.Row, 58))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g2 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then c(x) = g2

          End With

          'фамили для заголовка формы
          fam = Cells(Target.Row, 4)
          Cancel = True
          UserForm1.Show

      End If
End Sub

[/vba]

Спасибо за поздравления! smile

smile

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

СообщениеЗдравствуйте smile

smile

Вроде бы так - но проверьте тщательно.
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      If Not Intersect(Target, [D2:D11]) Is Nothing Then
          Dim a(), b(), i&, cc As Range, flag As Boolean, x&
          Dim g1$, g2$

          'заголовки списка турниров для листбокса берутся с листа из этих ячеек!!!
          g1 = [Y12]
          g2 = [AW12]

          'берём в массивы списки турниров
          a = Range(Cells(14, "AC"), Cells(Rows.Count, "N").End(xlUp)).Value
          b = Range(Cells(14, "BA"), Cells(Rows.Count, "AO").End(xlUp)).Value

          'заносим в словарь номера турниров (с заголовком списка турниров впереди)
          'в Item словаря помещаем данные турнира, для красоты месяцу добавляем пробелы
          With CreateObject("Scripting.Dictionary")
              .CompareMode = vbTextCompare
              For i = 1 To UBound(a)
                  .Add g1 & "|" & a(i, 1), Left(a(i, 1) & "    ", 4) & Left(a(i, 13) & "          ", 10) & a(i, 2)
              Next
              For i = 1 To UBound(b)
                  .Add g2 & "|" & b(i, 1), Left(b(i, 1) & "    ", 4) & Left(b(i, 13) & "          ", 10) & b(i, 2)
              Next

              'заносим данные из словаря в массив для листбокса
              ReDim c(0)

              'перебираем строку 2012 года
              For Each cc In Range(Cells(Target.Row, 21), Cells(Target.Row, 40))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g1 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then
                  c(0) = g1
                  flag = False
                  ReDim Preserve c(UBound(c) + 1)
                  x = UBound(c)
              End If

              'перебираем строку 2011 года
              For Each cc In Range(Cells(Target.Row, 41), Cells(Target.Row, 58))
                  If Len(cc.Value) Then
                      flag = True
                      temp = g2 & "|" & cc.Value
                      If .exists(temp) Then
                          ReDim Preserve c(UBound(c) + 1): c(UBound(c)) = .Item(temp)
                      End If
                  End If
              Next

              If flag Then c(x) = g2

          End With

          'фамили для заголовка формы
          fam = Cells(Target.Row, 4)
          Cancel = True
          UserForm1.Show

      End If
End Sub

[/vba]

Спасибо за поздравления! smile

smile

Автор - Hugo
Дата добавления - 29.12.2011 в 02:27

Дата: Четверг, 29.12.2011, 02:42 | Сообщение № 30

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Я вроде сама нашла
Было почему-то так:
[vba]

Код

For i = 1 To UBound(b)
.Add g2 & "|" & a(i, 1), Left(b(i, 1) & " ", 4) & Left(b(i, 13) & " ", 10) & b(i, 2)

[/vba]

Тут я просто а заменила на b и все ок !!!
Я права ?

Не знаю откуда она вылезла.
Спасибо.

Ответить

Дата: Четверг, 29.12.2011, 11:42 | Сообщение № 31

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Да, исправил это и кажется ещё чуть диапазоны подвинул - можете сохранить оба кода в два текста и сравнить их в ТоталКоммандере, если интересно.

Сам сравнил - разница в 4-х строках, вот Ваши:

      a = Range(Cells(13, "AC"), Cells(Rows.Count, "N").End(xlUp)).Value
         b = Range(Cells(13, "BA"), Cells(Rows.Count, "AO").End(xlUp)).Value

                 .Add g2 & "|" & a(i, 1), Left(b(i, 1) & "    ", 4) & Left(b(i, 13) & "          ", 10) & b(i, 2)

             For Each cc In Range(Cells(Target.Row, 14), Cells(Target.Row, 40))

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Суббота, 31.12.2011, 02:33 | Сообщение № 32

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Здравствуйте Hugo. На 13 изменила, что-бы подвинуть месяц, а что означает параметр 14 ? Он за что отвечает? (выделен красным). Кстати и 40 - если не трудно поясните на будущее. Спасибо !

Ответить

Дата: Суббота, 31.12.2011, 11:01 | Сообщение № 33

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Range(Cells(Target.Row, 14), Cells(Target.Row, 40)) = Range(Cells(Target.Row, "N"), Cells(Target.Row, "AN"))

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Суббота, 31.12.2011, 17:21 | Сообщение № 34

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3255

Репутация: 707 ±

Замечаний: 0% ±

2019

Строка кода
[vba]

Code

a = Range(Cells(13, "AC"), Cells(Rows.Count, "N").End(xlUp)).Value

[/vba]
означает - берём в массив диапазон, начиная с 13-ой строки столбца AC до последней заполненной ячейки в столбце N.
Можно записать и иначе, но 13 нужно заменить на 14 потому, что полезные данные начинаются с 14-ой строки.
Можно оставить и 13, ошибки не будет, но и толку тоже.

И как правильно заметил RAN, лучше и понятнее всё изменить на запись вида Cells(Target.Row, "N") - так проще изменять код будет в дальнейшем. Тут я сразу не подумал об удобстве...

Code

For Each cc In Range(Cells(Target.Row, "N"), Cells(Target.Row, "AD"))
For Each cc In Range(Cells(Target.Row, "AO"), Cells(Target.Row, "BF"))

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Суббота, 31.12.2011, 18:39 | Сообщение № 35

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Репутация: 193 ±

Замечаний: 0% ±

проверка

happy

[vba]

Code

For Each cc In Range(Cells(Target.Row, "N"), Cells(Target.Row, "AD"))
For Each cc In Range(Cells(Target.Row, "AO"), Cells(Target.Row, "BF"))

[/vba]

Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba

Ответить

Дата: Суббота, 31.12.2011, 22:31 | Сообщение № 36

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Всем спасибо! Вроде разобралась.
Всех еще раз с Новым Годом и хорошим настроением. Удачи , здоровья Вам и Вашим близким !!!

Ответить

Ссылки на другие ячейки в таблице

Страница 2 из 2
«
1
2

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