Елена, Вы верно поняли, менять адреса только тут. Но, если будут меняться списки турниров в ширину, т.е. двигаться колонки, то ещё нужно подкорректировать цифры в строке [vba]
[/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 лет держать - старые листы можно просто скрыть, чтоб не мешались, если напрягают.
Елена, Вы верно поняли, менять адреса только тут. Но, если будут меняться списки турниров в ширину, т.е. двигаться колонки, то ещё нужно подкорректировать цифры в строке [vba]
[/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 лет держать - старые листы можно просто скрыть, чтоб не мешались, если напрягают.Hugo
RAN Вы молодец и наверное это отличное решение, но только под решение Hugo уже все переделали а скачать не можем: http://www.excelworld.ru/_fr/10/-rating-NEW1-Hu.rar (Невозможно найти ресурс) По фамилии и имени это правильнее (для нас - убедились) и хранить более 2-х лет нет необходимости. Если игрок становится профи - данные по нему есть на международных сайтах. А если нет, то информация устаревает и старые турниры для изучения не нужны. Спасибо и ждем -rating-NEW1-Hu.rar от Hugo RAN вы классный специалист.
RAN Вы молодец и наверное это отличное решение, но только под решение Hugo уже все переделали а скачать не можем: http://www.excelworld.ru/_fr/10/-rating-NEW1-Hu.rar (Невозможно найти ресурс) По фамилии и имени это правильнее (для нас - убедились) и хранить более 2-х лет нет необходимости. Если игрок становится профи - данные по нему есть на международных сайтах. А если нет, то информация устаревает и старые турниры для изучения не нужны. Спасибо и ждем -rating-NEW1-Hu.rar от Hugo RAN вы классный специалист. Elena92
Добрый вечер Hugo А там в новом файле только то,о чем Вы писали в Сообщении № 18 Я сама поправила то, о чем писали Вы в этом сообщении и все стало ОК. или что-то еще? Уже начинаю собой беспочвенно гордиться после Сообщение № 21 Что я все верно поняла.
Добрый вечер Hugo А там в новом файле только то,о чем Вы писали в Сообщении № 18 Я сама поправила то, о чем писали Вы в этом сообщении и все стало ОК. или что-то еще? Уже начинаю собой беспочвенно гордиться после Сообщение № 21 Что я все верно поняла.
Все отлично Hugo, но настоящий молодец это ВЫ !!! В этом файле остался у меня только один вопрос - он более информативный и очень маленький, чем принципиальный но боюсь меня заругают, т.к. тема немного другая.
Сейчас создам тему...
Все отлично Hugo, но настоящий молодец это ВЫ !!! В этом файле остался у меня только один вопрос - он более информативный и очень маленький, чем принципиальный но боюсь меня заругают, т.к. тема немного другая.
Здравствуйте Hugo! Попыталась сделать заготовку этого-же файла на новый год и поняла, что я-дуреха опять не могу ни с чем справиться самостоятельно. Тут всего вроде уменьшилось кол-во ячеек в турнирах 2012 года и перенеслась колонка месяц в этом же годе. (она теперь 13 по номеру, а не 16), ну и поменялись местами турниры 2012 года (возникли) и 2011 встали на место 2010. Вроде все подправила, а двойной клик выдает ошибку. Не могу понять в чем дело. Что-то очень простое, а что мне не ведомо.
С наступающим Новым годом всех, кто мне помогал или пытался помогать или слегка поругивал. Желаю всяческих удач Вам , здоровья Вам и Вашим близким, успехов в профессиональном и карьерном росте , любви, радости и хорошего настроения !
Здравствуйте Hugo! Попыталась сделать заготовку этого-же файла на новый год и поняла, что я-дуреха опять не могу ни с чем справиться самостоятельно. Тут всего вроде уменьшилось кол-во ячеек в турнирах 2012 года и перенеслась колонка месяц в этом же годе. (она теперь 13 по номеру, а не 16), ну и поменялись местами турниры 2012 года (возникли) и 2011 встали на место 2010. Вроде все подправила, а двойной клик выдает ошибку. Не могу понять в чем дело. Что-то очень простое, а что мне не ведомо.
С наступающим Новым годом всех, кто мне помогал или пытался помогать или слегка поругивал. Желаю всяческих удач Вам , здоровья Вам и Вашим близким, успехов в профессиональном и карьерном росте , любви, радости и хорошего настроения !Elena92
Здравствуйте Вроде бы так - но проверьте тщательно. [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]
Спасибо за поздравления!
Здравствуйте Вроде бы так - но проверьте тщательно. [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
Здравствуйте Hugo. На 13 изменила, что-бы подвинуть месяц, а что означает параметр 14 ? Он за что отвечает? (выделен красным). Кстати и 40 - если не трудно поясните на будущее. Спасибо !
Здравствуйте Hugo. На 13 изменила, что-бы подвинуть месяц, а что означает параметр 14 ? Он за что отвечает? (выделен красным). Кстати и 40 - если не трудно поясните на будущее. Спасибо !Elena92
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"))
Строка кода [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"))