Bir sayfaya 2 ayrı kod yazma sorunu

[Ergün Güler]

Selam Arkadaşlar,

Aşağıdaki her iki kodu aynı sayfaya ayrı ayrı yazınca problem yok. ancak berebar kullanınca hata veriyor nasıl uygulmam gerekir?
Klay gelsin.

1.:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then
Cells.Select
Cells.EntireRow.AutoFit
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & [g6] + 9
Cells(1, 2).Select
End If
End Sub

2.:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim HÜCRE As Range

If Intersect(Target, Range("D910000,E9:E10000")) Is Nothing Then Exit Sub

On Error Resume Next

Application.ScreenUpdating = False

For Each HÜCRE In Range(Cells(1, Target.Column), Cells(10000, Target.Column))
If HÜCRE.Column = 4 Then
If HÜCRE.Value >= 1 And HÜCRE.Value <= 10 Then HÜCRE.NumberFormat = "#,## ""Yıllık"""
If HÜCRE.Value >= 50 And HÜCRE.Value <= 15000 Then HÜCRE.NumberFormat = "#,## ""Saatlik"""
If HÜCRE.Value >= 16000 And HÜCRE.Value <= 500000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value >= 10000000 And HÜCRE.Value <= 40000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""


ElseIf HÜCRE.Column = 5 Then
If HÜCRE.Value > 0 And HÜCRE.Value <= 320000 Then HÜCRE.NumberFormat = "#,## ""Saat"""
If HÜCRE.Value > 320000 And HÜCRE.Value < 10900000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value > 10900000 And HÜCRE.Value < 500000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""
End If
Next

Application.ScreenUpdating = True
End Sub

 

[halit3]

böyle denermisiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$1" Then
Cells.Select
Cells.EntireRow.AutoFit
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & [g6] + 9
Cells(1, 2).Select
End If

Dim HÜCRE As Range
If Intersect(Target, Range("D910000,E9:E10000")) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
For Each HÜCRE In Range(Cells(1, Target.Column), Cells(10000, Target.Column))
If HÜCRE.Column = 4 Then
If HÜCRE.Value >= 1 And HÜCRE.Value <= 10 Then HÜCRE.NumberFormat = "#,## ""Yıllık"""
If HÜCRE.Value >= 50 And HÜCRE.Value <= 15000 Then HÜCRE.NumberFormat = "#,## ""Saatlik"""
If HÜCRE.Value >= 16000 And HÜCRE.Value <= 500000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value >= 10000000 And HÜCRE.Value <= 40000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""

ElseIf HÜCRE.Column = 5 Then
If HÜCRE.Value > 0 And HÜCRE.Value <= 320000 Then HÜCRE.NumberFormat = "#,## ""Saat"""
If HÜCRE.Value > 320000 And HÜCRE.Value < 10900000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value > 10900000 And HÜCRE.Value < 500000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Ergün Güler]

Sayın Halit3,
Kodu uyguladım. Range("D910000,E9:E10000") kısmını düzelttim. Ancak, C1 hücresinin içine bir türlü giremiyorum. İçeriğini değiştiremiyorum. Ekran yenileniyor sanki. Makrodan anlamıyorum ancak, Application.ScreenUpdating aktif olduğunda değil de C1 hücresini değiştirdiğimde herşeyi yapsa nasıl olur. Galiba bu şekil çalışır diye düşünüyorum.
Kolay gelsin.

 

[halit3]

birde böyle denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then
Cells.Select
Cells.EntireRow.AutoFit
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & [g6] + 9
Cells(1, 2).Select
Exit Sub
End If

Dim HÜCRE As Range
If Intersect(Target, Range("D910000,E9:E10000")) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
For Each HÜCRE In Range(Cells(1, Target.Column), Cells(10000, Target.Column))
If HÜCRE.Column = 4 Then
If HÜCRE.Value >= 1 And HÜCRE.Value <= 10 Then HÜCRE.NumberFormat = "#,## ""Yıllık"""
If HÜCRE.Value >= 50 And HÜCRE.Value <= 15000 Then HÜCRE.NumberFormat = "#,## ""Saatlik"""
If HÜCRE.Value >= 16000 And HÜCRE.Value <= 500000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value >= 10000000 And HÜCRE.Value <= 40000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""

ElseIf HÜCRE.Column = 5 Then
If HÜCRE.Value > 0 And HÜCRE.Value <= 320000 Then HÜCRE.NumberFormat = "#,## ""Saat"""
If HÜCRE.Value > 320000 And HÜCRE.Value < 10900000 Then HÜCRE.NumberFormat = "#,## ""Paket"""
If HÜCRE.Value > 10900000 And HÜCRE.Value < 500000000 Then HÜCRE.NumberFormat = "#,## ""İnsört"""
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Ergün Güler]

Sayın Halit3,
Yardımlarınız için çok teşekkürler Ancak, başlangıçta çalıyor ancak bazı hücrelerde yenilenmiyor. Ayrıca, herhangi bir değişiklik sonrası D ve E sütunlarındaki hücre biçimleri yenilenmiyor. Mesela, "Yıllık" yerine "Senelik" yazsak bile yenilenmiyor. 2. bir örnek, D ve E sütunlardaki hücreleri "genel" olarak biçimledim. Sayfa yenilendiği zaman kodlar geçerli olmuyor, yenilenmiyor. Dosyayı yeniden açtım kapadım olmadı, makroları çalıştırdım olmadı. Anca size ilke verdiğim örnekte yalnız başına kullandığımda oluyordu.
Kolay gelsin.