Суть проблемы в следующем. Хочется упростить себе работу по проверке билетов лото в реальном времени. В приложенном файле есть серое поле (назовем поле ведущего), и 10 розовых полей (билеты лото). Ведущий называет цифры, которые я отмечаю в сером поле приложенного файла. В билетах указаны одинаковые цифры, хотя они конечно будут все разные и меняться при каждом тираже лото. При клике на ячейку в поле ведущего, требуется, что она выделяется желтым цветом и также цифра этой ячейки отыскивается в билетах и выделяется желтым цветом. При заполнении какой-либо строки в билете, строка выделяется красным цветом. Вот такой файл хотелось бы иметь. Сам я сделать такое не могу, ума не хватает, надеюсь на помощь специалистов. С Exel дружу на уровне пользователя. Спасибо.
Суть проблемы в следующем. Хочется упростить себе работу по проверке билетов лото в реальном времени. В приложенном файле есть серое поле (назовем поле ведущего), и 10 розовых полей (билеты лото). Ведущий называет цифры, которые я отмечаю в сером поле приложенного файла. В билетах указаны одинаковые цифры, хотя они конечно будут все разные и меняться при каждом тираже лото. При клике на ячейку в поле ведущего, требуется, что она выделяется желтым цветом и также цифра этой ячейки отыскивается в билетах и выделяется желтым цветом. При заполнении какой-либо строки в билете, строка выделяется красным цветом. Вот такой файл хотелось бы иметь. Сам я сделать такое не могу, ума не хватает, надеюсь на помощь специалистов. С Exel дружу на уровне пользователя. Спасибо.smilord
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]
Код
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
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]
Доделал. [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
Да, нажимая на любую ячейку серого поля ничего не происходит. В Exel макросы включил (Разработчик -> Безопасность макросов -> Включить все макросы). Exel 2010, на 2-х компьютерах попробовал, ничего не происходит. Может еще что-то включить нужно?
Да, нажимая на любую ячейку серого поля ничего не происходит. В Exel макросы включил (Разработчик -> Безопасность макросов -> Включить все макросы). Exel 2010, на 2-х компьютерах попробовал, ничего не происходит. Может еще что-то включить нужно?smilord
Хочу поблагодарить за этот файл, очень нужная вещь. У меня работает, но два вопроса: 1. Когда я забиваю свои билеты, у меня цифры в билетах заливаются красным, а не желтым. 2. Если допустим ошибся и кликнул не на ту цифру в поле ведущего, нельзя никак сделать шаг назад. (стрелкой отмена не получилось).
Хочу поблагодарить за этот файл, очень нужная вещь. У меня работает, но два вопроса: 1. Когда я забиваю свои билеты, у меня цифры в билетах заливаются красным, а не желтым. 2. Если допустим ошибся и кликнул не на ту цифру в поле ведущего, нельзя никак сделать шаг назад. (стрелкой отмена не получилось).alex944
И еще, можно ли сделать немного по-другому принципу. В верхнее поле вводятся цифры и одновременно они же заливаются желтым в билетах, в которых есть. А если в билете закрывается строка (5 цифр отмечаются), то чтобы заливка салатовым цветом была, а не красным. Спасибо!
И еще, можно ли сделать немного по-другому принципу. В верхнее поле вводятся цифры и одновременно они же заливаются желтым в билетах, в которых есть. А если в билете закрывается строка (5 цифр отмечаются), то чтобы заливка салатовым цветом была, а не красным. Спасибо!alex944