Страницы: 1
RSS
Турнирная таблица ДАРТС ! ))), Нужна помощь по МАКРОСАМ
 
Приветствую, господа!
Пишу на excel'е таблицу подсчетов очков для игры в ДАРТС (интерфейс в файле).
Столкнулся с  проблемой, как поместить в ячейку имя игрока с лучшим прогрессом - "имя игрока".
Стандартными формулами не получилось, решил использовать макросы.
Написал макрос, который бегает по ячейкам, ищет нужные значения, запоминает позицию где он нашел, и в зависимости от этого выцепляет имя игрока.
Потестил - все работает. Оставался один шаг. Сделать автоматический запуск макроса, когда меняется любая из ячеек диапазона с очками.
И тут начались проблемы!
Для автозапуска добавил в лист, следующий код:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B9:F37" ;) ) Is Nothing Then
        Call Who_is_sniper_and_champion
    End If
End Sub

Основной макрос находится в книге:
Код
Sub Who_is_sniper_and_champion()
    ' Определение снайпера
    best_shoot = Sheets("Игра").Cells(4, 10).Value 'çзабираем лучшую попытку из ячейки J:4
    best_shoot_column = Sheets("Игра").Cells.Find(What:=best_shoot).Column 'определяем номер столбца в котором нужное значение
    best_shoot_row = Sheets("Игра").Cells.Find(What:=best_shoot).Row 'определяем номер строки в котором нужное значение
    result_best_shoot = Sheets("Игра").Cells(3, best_shoot_column).Value 'идем к именам
    Sheets("Игра").Cells(4, 14).Value = result_best_shoot 'помещаем имя в красивую рамку
        
    ' Определение лидера
    Cells(7, 10).Value = ""
    best_progress = Worksheets("Данные").Cells(3, 11).Value Забираем лучший прогресс из листа "Данные" ячейки K:3
    If best_progress > 0 Then
        pos = 1
        For Each c In Worksheets("Игра").Range("B5:F5")
            pos = pos + 1
            If c.Value = best_progress Then
                best_progress_column = pos 'номер столбца с нужным нам именем
                result_best_progress = Cells(3, best_progress_column).Value 'копируем имя в переменную
                Cells(7, 10).Value = result_best_progress 'вставляем в красивую рамку
            End If
        Next c
    End If
End Sub

Так вот после добавления в лист автозапуска, компилятор стал ругаться на основной макроса.
Кто в теме, гляньте, плз. А в чем беда не пойму. Столкнулся с задачей
Изменено: DendyBoy - 07.05.2014 22:31:36
 
Оформляйте код тегом.
 
Цитата
DendyBoy пишет: Кто в теме, гляньте, плз
В теме "дартс" ? Файл покажите.
 
DendyBoy, добавьте 2 строки
Код
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B9:F37")) Is Nothing Then
       Application.EnableEvents = False
        Call Who_is_sniper_and_champion
       Application.EnableEvents = True
    End If
End Sub
 
 
Частично сократим:

Код
'    best_shoot = Sheets("Игра").Cells(4, 10).Value 'c,забираем лучшую попытку из ячейки J:4
'    best_shoot_column = Sheets("Игра").Cells.Find(What:=best_shoot).Column 'определяем номер столбца в котором нужное значение
'    best_shoot_row = Sheets("Игра").Cells.Find(What:=best_shoot).Row 'определяем номер строки в котором нужное значение
'    result_best_shoot = Sheets("Игра").Cells(3, best_shoot_column).Value 'идем к именам
'    Sheets("Игра").Cells(4, 14).Value = result_best_shoot 'помещаем имя в красивую рамку

With Sheets("Игра")
.Cells(4, 14).Value = .Cells(3, .Cells.Find(What:=.Cells(4, 10).Value).Column).Value
End With

 
Не оговорен случай, если лучших результатов >1
Страницы: 1
Наверх