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

Вход

Регистрация

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

 

= Мир MS Excel/Проверка билетов лото - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Проверка билетов лото (Формулы/Formulas)
Проверка билетов лото
smilord Дата: Вторник, 28.03.2017, 07:17 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Суть проблемы в следующем. Хочется упростить себе работу по проверке билетов лото в реальном времени. В приложенном файле есть серое поле (назовем поле ведущего), и 10 розовых полей (билеты лото). Ведущий называет цифры, которые я отмечаю в сером поле приложенного файла. В билетах указаны одинаковые цифры, хотя они конечно будут все разные и меняться при каждом тираже лото. При клике на ячейку в поле ведущего, требуется, что она выделяется желтым цветом и также цифра этой ячейки отыскивается в билетах и выделяется желтым цветом. При заполнении какой-либо строки в билете, строка выделяется красным цветом. Вот такой файл хотелось бы иметь. Сам я сделать такое не могу, ума не хватает, надеюсь на помощь специалистов. С Exel дружу на уровне пользователя. Спасибо.
К сообщению приложен файл: 4003426.xls (30.5 Kb)
 
Ответить
СообщениеСуть проблемы в следующем. Хочется упростить себе работу по проверке билетов лото в реальном времени. В приложенном файле есть серое поле (назовем поле ведущего), и 10 розовых полей (билеты лото). Ведущий называет цифры, которые я отмечаю в сером поле приложенного файла. В билетах указаны одинаковые цифры, хотя они конечно будут все разные и меняться при каждом тираже лото. При клике на ячейку в поле ведущего, требуется, что она выделяется желтым цветом и также цифра этой ячейки отыскивается в билетах и выделяется желтым цветом. При заполнении какой-либо строки в билете, строка выделяется красным цветом. Вот такой файл хотелось бы иметь. Сам я сделать такое не могу, ума не хватает, надеюсь на помощь специалистов. С Exel дружу на уровне пользователя. Спасибо.

Автор - smilord
Дата добавления - 28.03.2017 в 07:17
sboy Дата: Вторник, 28.03.2017, 11:09 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Проверяйте
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range(Cells(4, 1), Cells(13, 10))) Is Nothing Then Exit Sub
Target.Interior.Color = vbYellow
With ActiveSheet.UsedRange
    Set c = .Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Color = vbYellow
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub
[/vba]
не сделал
При заполнении какой-либо строки в билете, строка выделяется красным цветом
К сообщению приложен файл: 5816742.xls (40.5 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Проверяйте
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range(Cells(4, 1), Cells(13, 10))) Is Nothing Then Exit Sub
Target.Interior.Color = vbYellow
With ActiveSheet.UsedRange
    Set c = .Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Color = vbYellow
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub
[/vba]
не сделал
При заполнении какой-либо строки в билете, строка выделяется красным цветом

Автор - sboy
Дата добавления - 28.03.2017 в 11:09
Perfect2You Дата: Вторник, 28.03.2017, 18:51 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 237
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Доделал.
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rN As Range
Dim iR As Long, iL As Long
Dim flR As Boolean, flL As Boolean, flG As Boolean

If Intersect(Target, Range(Cells(4, 1), Cells(13, 10))) Is Nothing Then Exit Sub
Target.Interior.Color = vbYellow
With ActiveSheet.UsedRange
    Set c = .Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            iR = 1
            iL = 1
            flR = True
            flL = True
            flG = True
            Do
                If (c.Address = Target.Address) Then GoTo NXT
                If Len(c.Offset(0, iR).Value) And (c.Offset(0, iR).Interior.Color = c.Interior.Color) Then
                    flG = False
                    Exit Do
                ElseIf c.Offset(0, iR).Interior.Color = vbWhite Then
                    flR = False
                End If
                If Len(c.Offset(0, -iL).Value) And (c.Offset(0, -iL).Interior.Color = c.Interior.Color) Then
                    flG = False
                    Exit Do
                ElseIf c.Offset(0, -iL).Interior.Color = vbWhite Then
                    flL = False
                End If
                If flL Then iL = iL + 1
                If flR Then iR = iR + 1
            Loop While flR Or flL
            If flG Then
                Range(c.Offset(0, 1 - iL), c.Offset(0, iR - 1)).Interior.Color = vbRed
            Else
                c.Interior.Color = vbYellow
            End If
NXT:            Set c = .FindNext(c)
        Loop Until (c Is Nothing) Or (c.Address = firstAddress)
    End If
End With
End Sub
[/vba]
К сообщению приложен файл: _4003426-1.xls (35.0 Kb)
 
Ответить
СообщениеДоделал.
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rN As Range
Dim iR As Long, iL As Long
Dim flR As Boolean, flL As Boolean, flG As Boolean

If Intersect(Target, Range(Cells(4, 1), Cells(13, 10))) Is Nothing Then Exit Sub
Target.Interior.Color = vbYellow
With ActiveSheet.UsedRange
    Set c = .Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            iR = 1
            iL = 1
            flR = True
            flL = True
            flG = True
            Do
                If (c.Address = Target.Address) Then GoTo NXT
                If Len(c.Offset(0, iR).Value) And (c.Offset(0, iR).Interior.Color = c.Interior.Color) Then
                    flG = False
                    Exit Do
                ElseIf c.Offset(0, iR).Interior.Color = vbWhite Then
                    flR = False
                End If
                If Len(c.Offset(0, -iL).Value) And (c.Offset(0, -iL).Interior.Color = c.Interior.Color) Then
                    flG = False
                    Exit Do
                ElseIf c.Offset(0, -iL).Interior.Color = vbWhite Then
                    flL = False
                End If
                If flL Then iL = iL + 1
                If flR Then iR = iR + 1
            Loop While flR Or flL
            If flG Then
                Range(c.Offset(0, 1 - iL), c.Offset(0, iR - 1)).Interior.Color = vbRed
            Else
                c.Interior.Color = vbYellow
            End If
NXT:            Set c = .FindNext(c)
        Loop Until (c Is Nothing) Or (c.Address = firstAddress)
    End If
End With
End Sub
[/vba]

Автор - Perfect2You
Дата добавления - 28.03.2017 в 18:51
smilord Дата: Вторник, 28.03.2017, 19:09 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
У меня не работает. Наверно куда-то вставить этот текст нужно? Подскажите, где его прописать.


Сообщение отредактировал smilord - Вторник, 28.03.2017, 19:26
 
Ответить
СообщениеУ меня не работает. Наверно куда-то вставить этот текст нужно? Подскажите, где его прописать.

Автор - smilord
Дата добавления - 28.03.2017 в 19:09
SGromov Дата: Среда, 29.03.2017, 01:37 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

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

Цитата
Разработчик -> Безопасность макросов -> Включить все макросы


Профит.
 
Ответить
СообщениеНичего не нужно никуда вставлять.
Просто необходимо изменить настройки безопасности макросов Excel.

Цитата
Разработчик -> Безопасность макросов -> Включить все макросы


Профит.

Автор - SGromov
Дата добавления - 29.03.2017 в 01:37
smilord Дата: Среда, 29.03.2017, 10:13 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Что-то не получается, включил все макросы, но результата нет.
 
Ответить
СообщениеЧто-то не получается, включил все макросы, но результата нет.

Автор - smilord
Дата добавления - 29.03.2017 в 10:13
sboy Дата: Среда, 29.03.2017, 10:22 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Скачал, проверил файл работает.
А что у Вас не получается?
делаете двойной щелчок по серому полю и ничего не происходит?


Яндекс: 410016850021169
 
Ответить
СообщениеСкачал, проверил файл работает.
А что у Вас не получается?
делаете двойной щелчок по серому полю и ничего не происходит?

Автор - sboy
Дата добавления - 29.03.2017 в 10:22
smilord Дата: Среда, 29.03.2017, 15:32 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Да, нажимая на любую ячейку серого поля ничего не происходит. В Exel макросы включил (Разработчик -> Безопасность макросов -> Включить все макросы). Exel 2010, на 2-х компьютерах попробовал, ничего не происходит. Может еще что-то включить нужно?
 
Ответить
СообщениеДа, нажимая на любую ячейку серого поля ничего не происходит. В Exel макросы включил (Разработчик -> Безопасность макросов -> Включить все макросы). Exel 2010, на 2-х компьютерах попробовал, ничего не происходит. Может еще что-то включить нужно?

Автор - smilord
Дата добавления - 29.03.2017 в 15:32
smilord Дата: Среда, 29.03.2017, 15:39 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Опа-на, все получается, я не делал двойной щелчок, из-за этого ничего не происходило. Все работает, большое спасибо, ребята.
 
Ответить
СообщениеОпа-на, все получается, я не делал двойной щелчок, из-за этого ничего не происходило. Все работает, большое спасибо, ребята.

Автор - smilord
Дата добавления - 29.03.2017 в 15:39
Perfect2You Дата: Среда, 29.03.2017, 15:39 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 237
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Файл с сайта скачали или сами макрос добавляли в свой файл?
Как нажимаете? Двойным щелчком?
 
Ответить
СообщениеФайл с сайта скачали или сами макрос добавляли в свой файл?
Как нажимаете? Двойным щелчком?

Автор - Perfect2You
Дата добавления - 29.03.2017 в 15:39
smilord Дата: Среда, 29.03.2017, 16:23 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Perfect2You, спасибо большое, все получилось. Нажимал не двойным щелчком, в этом была проблема.
 
Ответить
СообщениеPerfect2You, спасибо большое, все получилось. Нажимал не двойным щелчком, в этом была проблема.

Автор - smilord
Дата добавления - 29.03.2017 в 16:23
alex944 Дата: Четверг, 05.10.2017, 16:24 | Сообщение № 12
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Хочу поблагодарить за этот файл, очень нужная вещь. У меня работает, но два вопроса:
1. Когда я забиваю свои билеты, у меня цифры в билетах заливаются красным, а не желтым.
2. Если допустим ошибся и кликнул не на ту цифру в поле ведущего, нельзя никак сделать шаг назад. (стрелкой отмена не получилось).
 
Ответить
СообщениеХочу поблагодарить за этот файл, очень нужная вещь. У меня работает, но два вопроса:
1. Когда я забиваю свои билеты, у меня цифры в билетах заливаются красным, а не желтым.
2. Если допустим ошибся и кликнул не на ту цифру в поле ведущего, нельзя никак сделать шаг назад. (стрелкой отмена не получилось).

Автор - alex944
Дата добавления - 05.10.2017 в 16:24
alex944 Дата: Четверг, 05.10.2017, 17:02 | Сообщение № 13
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
И еще, можно ли сделать немного по-другому принципу.
В верхнее поле вводятся цифры и одновременно они же заливаются желтым в билетах, в которых есть.
А если в билете закрывается строка (5 цифр отмечаются), то чтобы заливка салатовым цветом была, а не красным. Спасибо!
К сообщению приложен файл: loto.xlsx (11.2 Kb)
 
Ответить
СообщениеИ еще, можно ли сделать немного по-другому принципу.
В верхнее поле вводятся цифры и одновременно они же заливаются желтым в билетах, в которых есть.
А если в билете закрывается строка (5 цифр отмечаются), то чтобы заливка салатовым цветом была, а не красным. Спасибо!

Автор - alex944
Дата добавления - 05.10.2017 в 17:02
iMrTidy Дата: Пятница, 06.10.2017, 00:44 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 14 ±
Замечаний: 0% ±

NO
alex944, без макросов, но условным форматированием и со скрытым доп. листом.
К сообщению приложен файл: 0816446.xlsx (20.4 Kb)


Вышенаписанное мной не является истиной, но лишь моя точка зрения, которая скорее всего ошибочна.
 
Ответить
Сообщениеalex944, без макросов, но условным форматированием и со скрытым доп. листом.

Автор - iMrTidy
Дата добавления - 06.10.2017 в 00:44
alex944 Дата: Пятница, 06.10.2017, 09:50 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
iMrTidy, спасибо огромное! то что надо! specool
 
Ответить
СообщениеiMrTidy, спасибо огромное! то что надо! specool

Автор - alex944
Дата добавления - 06.10.2017 в 09:50
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Проверка билетов лото (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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