- Katılım
- 8 Mart 2009
- Mesajlar
- 504
- Excel Vers. ve Dili
- 2010
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [V:V]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("Harita")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(Target.Row, 2).Value
Set renk = [AA:AA].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "aa").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(Target.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(1, 22).Value = Cells(4, 35).Value
Cells(2, 22).Value = Cells(5, 35).Value
Cells(3, 22).Value = Cells(6, 35).Value
Cells(4, 22).Value = Cells(7, 35).Value
Cells(5, 22).Value = Cells(8, 35).Value
Cells(6, 22).Value = Cells(9, 35).Value
Cells(7, 22).Value = Cells(10, 35).Value
Cells(8, 22).Value = Cells(11, 35).Value
Cells(9, 22).Value = Cells(12, 35).Value
Cells(10, 22).Value = Cells(13, 35).Value
Cells(11, 22).Value = Cells(14, 35).Value
Cells(12, 22).Value = Cells(15, 35).Value
Cells(13, 22).Value = Cells(16, 35).Value
Cells(14, 22).Value = Cells(17, 35).Value
Cells(15, 22).Value = Cells(18, 35).Value
Cells(16, 22).Value = Cells(19, 35).Value
Cells(17, 22).Value = Cells(20, 35).Value
Cells(18, 22).Value = Cells(21, 35).Value
Cells(19, 22).Value = Cells(22, 35).Value
Cells(20, 22).Value = Cells(23, 35).Value
Cells(21, 22).Value = Cells(24, 35).Value
Cells(22, 22).Value = Cells(25, 35).Value
Cells(23, 22).Value = Cells(26, 35).Value
Cells(24, 22).Value = Cells(27, 35).Value
Cells(25, 22).Value = Cells(28, 35).Value
Cells(26, 22).Value = Cells(29, 35).Value
Cells(27, 22).Value = Cells(30, 35).Value
Cells(28, 22).Value = Cells(31, 35).Value
Cells(29, 22).Value = Cells(32, 35).Value
Cells(30, 22).Value = Cells(33, 35).Value
Cells(31, 22).Value = Cells(34, 35).Value
Cells(32, 22).Value = Cells(35, 35).Value
Cells(33, 22).Value = Cells(36, 35).Value
Cells(34, 22).Value = Cells(37, 35).Value
Cells(35, 22).Value = Cells(38, 35).Value
Cells(36, 22).Value = Cells(39, 35).Value
Cells(37, 22).Value = Cells(40, 35).Value
Cells(38, 22).Value = Cells(41, 35).Value
Cells(39, 22).Value = Cells(42, 35).Value
Cells(40, 22).Value = Cells(43, 35).Value
Cells(41, 22).Value = Cells(44, 35).Value
Cells(42, 22).Value = Cells(45, 35).Value
Cells(43, 22).Value = Cells(46, 35).Value
End Sub
bu makrolar iller ve harita sayfasındaydılar bunların harita sayfasında birleştirdim ancak haritada renklenmesi gereken bölümler renklenmeyip harita komple renga renk yanıp sönmeye başladı, nerede hata var makrodan anlamadığım için yapamadım yardımcı olursanız sevinirim. Teşekkürler.
If Intersect(Target, [V:V]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("Harita")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(Target.Row, 2).Value
Set renk = [AA:AA].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "aa").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(Target.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(1, 22).Value = Cells(4, 35).Value
Cells(2, 22).Value = Cells(5, 35).Value
Cells(3, 22).Value = Cells(6, 35).Value
Cells(4, 22).Value = Cells(7, 35).Value
Cells(5, 22).Value = Cells(8, 35).Value
Cells(6, 22).Value = Cells(9, 35).Value
Cells(7, 22).Value = Cells(10, 35).Value
Cells(8, 22).Value = Cells(11, 35).Value
Cells(9, 22).Value = Cells(12, 35).Value
Cells(10, 22).Value = Cells(13, 35).Value
Cells(11, 22).Value = Cells(14, 35).Value
Cells(12, 22).Value = Cells(15, 35).Value
Cells(13, 22).Value = Cells(16, 35).Value
Cells(14, 22).Value = Cells(17, 35).Value
Cells(15, 22).Value = Cells(18, 35).Value
Cells(16, 22).Value = Cells(19, 35).Value
Cells(17, 22).Value = Cells(20, 35).Value
Cells(18, 22).Value = Cells(21, 35).Value
Cells(19, 22).Value = Cells(22, 35).Value
Cells(20, 22).Value = Cells(23, 35).Value
Cells(21, 22).Value = Cells(24, 35).Value
Cells(22, 22).Value = Cells(25, 35).Value
Cells(23, 22).Value = Cells(26, 35).Value
Cells(24, 22).Value = Cells(27, 35).Value
Cells(25, 22).Value = Cells(28, 35).Value
Cells(26, 22).Value = Cells(29, 35).Value
Cells(27, 22).Value = Cells(30, 35).Value
Cells(28, 22).Value = Cells(31, 35).Value
Cells(29, 22).Value = Cells(32, 35).Value
Cells(30, 22).Value = Cells(33, 35).Value
Cells(31, 22).Value = Cells(34, 35).Value
Cells(32, 22).Value = Cells(35, 35).Value
Cells(33, 22).Value = Cells(36, 35).Value
Cells(34, 22).Value = Cells(37, 35).Value
Cells(35, 22).Value = Cells(38, 35).Value
Cells(36, 22).Value = Cells(39, 35).Value
Cells(37, 22).Value = Cells(40, 35).Value
Cells(38, 22).Value = Cells(41, 35).Value
Cells(39, 22).Value = Cells(42, 35).Value
Cells(40, 22).Value = Cells(43, 35).Value
Cells(41, 22).Value = Cells(44, 35).Value
Cells(42, 22).Value = Cells(45, 35).Value
Cells(43, 22).Value = Cells(46, 35).Value
End Sub
bu makrolar iller ve harita sayfasındaydılar bunların harita sayfasında birleştirdim ancak haritada renklenmesi gereken bölümler renklenmeyip harita komple renga renk yanıp sönmeye başladı, nerede hata var makrodan anlamadığım için yapamadım yardımcı olursanız sevinirim. Teşekkürler.
