ошибка времени выполнения 1004 при попытке выбора диапазона значений прямоугольника - PullRequest
0 голосов
/ 16 марта 2012

Интересно, кто-нибудь знает, как выбрать диапазон значений прямоугольника? Этот диапазон не будет фиксированным. Для этого конкретного примера он выберет B5 - G7 в форме прямоугольника, а затем установит формат условия для добавления в некоторые цвета.

Я попытался выполнить код, но в этой части он выдает ошибку

ActiveSheet.Cells(colorrow & "2", _
ActiveSheet.Cells(colorrow & "2").End(xlDown).End(xlToRight)).Select

Интересно, кто-нибудь знает почему? буду благодарен!

enter image description here

Я попытался написать какое-то кодирование.

Мой код выглядит следующим образом:

Sub Macro2()

 Dim thevaluestocopy As Variant, colorCell as Range, colorrow as Long, thefirstcolorrow as Long

 colorrow = 1

Do

Set colorCell = Sheets("Sheet1").Cells(colorrow, 1)
'check for test1-test6 if its around do nothing, else goes to the next row and next column
If colorCell = "test1" Or colorCell = "test2" Or colorCell = "test3" _
Or colorCell = "test4" Or colorCell = "test5" Or colorCell = "test6" _ Then 
'Do nothing
Else
thefirstcolorrow = Sheets("Sheet1").Cells(colorrow, 2)
'This statement gives me the error.. not sure why it cant work 
ActiveSheet.Cells(colorrow & "2", _
ActiveSheet.Cells(colorrow & "2").End(xlDown).End(xlToRight)).Select
Exit Do
End If
colorrow = colorrow + 1
Loop


'add colors into cell
ActiveCell.Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
    xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
    .Color = 8109667
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
    xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
    .Color = 8711167
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
    xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
    .Color = 7039480
End With

End Sub

Ответы [ 2 ]

0 голосов
/ 16 марта 2012

Я нашел способ.и хотел бы поделиться этим с остальными ..

Sub Macro2()

Dim colorCell As Range, colorrow As Long, thefirstcolorrow As Long, colorrow1 As Long, colorCell1 As Range, nvalue As Long
Dim thelastcolorRow As Long, n As Long, LastColtocolor As Long

colorrow = 1

LastColtocolor = Sheets("Sheet1").Cells("1" & Columns.Count).End(xlToLeft).Column

Do

Set colorCell = Sheets("Sheet1").Cells(colorrow, 1)

'Check if cell holds any value of test1 - test6, etc...
If colorCell = "test1" Or colorCell = "test2" Or colorCell = "test3" _
Or colorCell = "test4" Or colorCell = "test5" Or colorCell = "test6" _ Then 
'Do nothing
 Else
 thefirstcolorrow = colorrow

Exit Do
End If

colorrow = colorrow + 1
Loop

colorrow1 = 1

Do
'Look for last row that has values
Set colorCell1 = Sheets("Sheet1").Cells(colorrow1, 1)
If colorCell1 = "" Then
thelastcolorRow = colorrow1

Exit Do
End If
colorrow1 = colorrow1 + 1
Loop

For nvalue = 1 To colorrow1 - 1 - colorrow

Sheets("Sheet1").Range(Cells(thefirstcolorrow, 2), Cells(thefirstcolorrow + nvalue, LastColtocolor)).Select

Next nvalue

End sub
0 голосов
/ 16 марта 2012

Я не уверен, что вы имеете в виду, но если вы хотите сослаться на прямоугольный диапазон в рабочей таблице, вы можете использовать следующее:

With Sheet1
  .Range(.Range("B5"), .Range("G7")).Select
End With

Это выберет B5: G7 вобъект называется Sheet1.В качестве альтернативы вы можете использовать имя листа:

With Sheets("Sheet 1")
  .Range(.Range("B5"), .Range("G7")).Select
End With

Обратите внимание, что Sheet1.Name, скорее всего, равен «Листу 1», т.е. Sheet1 - это объект, «Sheet 1» - это имя объекта.Если вы поймете (или научитесь понимать) это различие, вы, вероятно, сделаете себе отличную услугу.

Редактировать: Изменить

ActiveSheet.Cells(colorrow & "2", _ ActiveSheet.Cells(colorrow & "2").End(xlDown).End(xlToRight)).Select

на

ActiveSheet.Range(ActiveSheet.Cells(colorrow & "2"), ActiveSheet.Cells(colorrow & "2").End(xlDown).End(xlToRight)).Select
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...