Здравствуйте, есть необходимость в определенной ячейке делать проверку данных по списку, т.е. выбирать из выпадающего списка. У ячейке обычно должен всегда находиться определенный текст, но иногда будут и другие данные. Как сделать, чтобы текст выбираемый из списка с первой строки был одного формата, а из других строк больше размером? т.е у меня сейчас в А1 текст Калибри 11, но если выбрать из выпадающего списка другие значения они были крупнее.. допустим Калибри 24
Здравствуйте, есть необходимость в определенной ячейке делать проверку данных по списку, т.е. выбирать из выпадающего списка. У ячейке обычно должен всегда находиться определенный текст, но иногда будут и другие данные. Как сделать, чтобы текст выбираемый из списка с первой строки был одного формата, а из других строк больше размером? т.е у меня сейчас в А1 текст Калибри 11, но если выбрать из выпадающего списка другие значения они были крупнее.. допустим Калибри 24ovechkin1973
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.CutCopyMode = False Application.DisplayAlerts = False Dim ff&, fif& ff = Cells(Rows.Count, 8).End(xlUp).Row D = Range("A1").Value If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub Set faf = Range("H1:H" & ff).Find(D) fif = faf.Row If fif > 1 Then Range("A1").Select With Selection.Font .Name = "Calibri" .Size = 24 End With Else Range("A1").Select With Selection.Font .Name = "Calibri" .Size = 11 End With End If Application.ScreenUpdating = True Application.CutCopyMode = True Application.DisplayAlerts = True End Sub
[/vba]
могу предложить макрос
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.CutCopyMode = False Application.DisplayAlerts = False Dim ff&, fif& ff = Cells(Rows.Count, 8).End(xlUp).Row D = Range("A1").Value If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub Set faf = Range("H1:H" & ff).Find(D) fif = faf.Row If fif > 1 Then Range("A1").Select With Selection.Font .Name = "Calibri" .Size = 24 End With Else Range("A1").Select With Selection.Font .Name = "Calibri" .Size = 11 End With End If Application.ScreenUpdating = True Application.CutCopyMode = True Application.DisplayAlerts = True End Sub