Страницы: 1
RSS
Выделение цветом всех влияющих ячеек на определенный диапазон
 
Добрый день, уважаемые коллеги!  
Помогите, пожалуйста, разобраться в следующей проблеме:  
на листе 1 имеются формулы с ссылками на ячейки с другого листа (лист 2). необходимо, чтобы макрос проходил по кажой связи в каждой ячейке и выделял цветом влияющую ячейку.  
в приложенном примере макрос есть, НО! почему-то при последнем проходе выдается ошибка. никак не могу понять почему...прошу, откройте глаза  незрячему))
 
Было бы в xls, посмотрел бы, а так... Качать и конвертировать лень.
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
{quote}{login=Alex_ST}{date=12.07.2011 12:00}{thema=}{post}Было бы в xls, посмотрел бы, а так... Качать и конвертировать лень.{/post}{/quote}  
Sub primer()  
'макрос выделяет цветом все ячейки, на которые ссылаются ячейки обозначенного диапазона  
imya_lista = ActiveSheet.Name  
ps = 2  
kstr = 3  
For i = 0 To kstr - 1  
ActiveWorkbook.Sheets(imya_lista).Cells(ps + i, 1).ShowPrecedents  
   For Z = 1 To 3  
  On Error GoTo metka  
   'On Error Resume Next  
    ActiveWorkbook.Sheets(imya_lista).Cells(i + ps, 1).NavigateArrow TowardPrecedent:=True, ArrowNumber:=1, LinkNumber _  
       :=Z  
       With Selection.Interior  
        .ThemeColor = xlThemeColorAccent1  
        .TintAndShade = 0.799981688894314  
        .PatternTintAndShade = 0  
       End With  
   Next Z  
metka:  
       If i = kstr - 1 Then  
           ActiveWorkbook.Sheets(imya_lista).Activate  
           ActiveSheet.ClearArrows  
       End If  
Next i  
ActiveWorkbook.Sheets(imya_lista).Activate  
ActiveSheet.ClearArrows  
End Sub
 
что-то с файлом...  
Попробую без файла погадать.    
Плохо, что у вас Option Explicit не используется...
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
В 2003-ем такого нет:  
.ThemeColor = xlThemeColorAccent1  
.TintAndShade = 0.799981688894314  
.PatternTintAndShade = 0  
 
Скачал post_240803.xlsm конвертер его открывать не хочет  
Ждите, может кто-нибудь с 2007/2010 подойдёт...  
 
А хоть какая ошибка и на какой команде?
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
Так попробуйте:  
 
Sub primertert()  
Dim kstr&, i&, z&  
kstr = 5: On Error Resume Next  
With ActiveSheet  
   For i = 2 To kstr  
       If .Cells(i, 1).HasFormula Then  
           z = 0: .Cells(i, 1).ShowPrecedents  
           Do  
               z = z + 1  
               .Cells(i, 1).NavigateArrow True, 1, z  
               If Err > 0 Then Err.Clear: Exit Do  
               Selection.Interior.ColorIndex = 36  
           Loop  
           .ClearArrows  
       End If  
   Next i  
End With  
End Sub  
 
Странный получился код, но работает. Проверял в Е2010.
 
заработало!) спасибо вам огромное!!!
Страницы: 1
Читают тему
Наверх