Worksheet_Change event hakkında ?

[mith]

S.A. arkadaşlar,
Bir makro yazdım, ve bu makroyu worksheet_change eventı ile beraber kullanmak istiyorum. Sorun şurdaki sayfanın sadece b2:b100 arasında değişiklik yapıldığında makro çalışsın aksi halde "Exit Sub" yapsın. Buraya yazılması gereken "If Then" koşulunu bulamadım.
2. sorunda module1 de çalışan makro worksheet_change de hata veriyor.
Yardımlarınızı bekliyorum.
Gerekli açıklama ek'te sunulmuştur..

 

[zafer]

Merhaba

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRng As Range
Set MyRng = Application.Intersect(Target, Range("B2:B100"))
If Not MyRng Is Nothing Then
makro adını yazınız
End If
Set MyRng = Nothing
End Sub

Değişken Myrange olunca Kaynak Sn.Haluk demek oluyor.

 

[mith]

Son birşey daha,
Range ayarını hem "b2:b100" hem de "e2:e100", yani iki sütüna değer girince diye,
nasıl modifiye edebilirim?
Bu arada makro çok güzel çalışıyor, teşekkürler..

 

[Levent Menteşoğlu]

Set MyRng = Application.Intersect(Target, Range("B2:B100"))

Yukarıdaki satırı aşağıdaki ile değiştirin.

Set MyRng = Application.Intersect(Target, Range("B2:B100,E2:E100"))

 

[mith]

Bir problem daha çıktı;
Kullandığım makrolar;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRng As Range
Set MyRng = Application.Intersect(Target, Range("B2:B100,E2:E100"))
If Not MyRng Is Nothing Then
boyama
End If
Set MyRng = Nothing
End Sub

Sub boyama()
Dim bul2 As Range
Dim bul3 As Range
If Selection.Offset(-1, 0).Value = "" Then
Selection.Offset(-1, 0).Interior.ColorIndex = xlNone
Exit Sub
End If
For Each bul2 In Range("Stok!a2:a" & [Stok!a65536].End(3).Row)
If bul2.Value = Selection.Offset(-1, 0).Value Then
Selection.Offset(-1, 0).Interior.ColorIndex = xlNone
For Each bul3 In Range("TOPLAM_ÜRETİM!b2:b" & [TOPLAM_ÜRETİM!b65536].End(3).Row)
If bul3.Value = Selection.Offset(-1, 0).Value Then
bul3.Offset(0, 1).Value = bul3.Offset(0, 1).Value + Selection.Offset(-1, -1).Value
bul3.Offset(0, -1).Value = bul2.Offset(0, 1).Value
GoTo Devam
End If
Next
Sheets("TOPLAM_ÜRETİM").[b65536].End(3).Offset(1, 0).Value = Selection.Offset(-1, 0).Value
Sheets("TOPLAM_ÜRETİM").[b65536].End(3).Offset(0, 1).Value = Selection.Offset(-1, -1).Value
Sheets("TOPLAM_ÜRETİM").[b65536].End(3).Offset(0, -1).Value = Selection.Offset(-1, 1).Value
Devam:
Exit For
End If

With Selection.Offset(-1, 0).Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Next

End Sub

***
Worksheet_Change eventını seçerken yapmak istediğim şey, o anda içinde değişiklik yapılan hücre için makroyu çalıştırmaktı. Fakat hücre içeriği değiştirilen bir hücreden sonra "enter" e basınca alt satıra geçiyor ve makro seçili olan alt hücre için çalışıyor. Ben bunu uyarlayarak alt hücre seçili iken değiştirilmiş olan bir üstteki hücreyi modifiye ediyor. Ama "tab" veya "ok tuşları" na basınca bir üstteki hücre değiştirilmiş hücre olmamış oluyor.
Diyeceğim o ki, acaba eventı mı doğru seçemedim. İstediğim şey hücre içeriği değiştirilmiş olan hücre için makro çalıştırmak. Sorun şu ki, hücre değerini değiştirdikten sonra hangi hücre aktif olursa olsun, sadece değiştirilmiş hücre için makro çalışsın. Umarım anlatabilmişimdir.
Yardımlarınızı bekliyorum.

 

[Levent Menteşoğlu]

kod içinde "selection" komutunu kullanırsanız, işlem o anda imleç hangi hücrede ise o hücre için yapılır. Bu sebeple target komutunu kullanmanız gereklidir. Benzer bir durum olduğu için aşağıdaki linkide incelemenizi öneririm.

http://www.excel.web.tr/viewtopic.php?t=10536&highlight=target

 

[mith]

Sn moderatör;
"target" komutunuda denemiştim, fakat target komutu module içerisinde tanınmıyor, yada ben tanıtamadım.Bu seferde bütün makroyu worksheet_change sayfasına ekleyeyim dedim; o zamanda diğer sayfalara yapmış olduğum göndermeler çalışmaz oldu. Mesela;
worksheet_change sayfasında bulunan;
For Each bul2 In Range("Stok!a2:a" & [Stok!a65536].End(3).Row)
satırı için hedef "stok" sayfasında olduğu için range hatası veriyor. veya diğer bazı sayfalara yazdıracağım sabit değerler için aynı hatayı veriyor.
Ya 2. şıktaki worksheet_change sayfasından diğer sayfalara birşeyler yazdırabilmeliyim, yada 1. şıktaki gibi worksheet_change sayfasından bir makroyu çalıştıracağım, ve o makroda "target" olarak worksheet_change sayfasındaki seçili hücreyi gösterebilmeliyim.. :?
Yardımlarınızı bekliyorum..

 

[Levent Menteşoğlu]

worksheet_change olayı ile diğer sayfalardada işlem yapabilirsiniz. Ama benim önerim bu kodlarınızın tüm sayfalardada aynı şekilde çalışmasını istiyorsanız, bu durumda kodlarınızı Thisworkbook modülüne ve aşağıdaki olaya yazabilirsiniz.

[vb:1:39f5d64409]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
.
.
.
End Sub
[/vb:1:39f5d64409]

Not:Target normal modüllerde kullanılamıyor haklısınız, bunu atlamışım.

 

[mith]

Kodları workbook eventsa ekleyince çok güzel çalıştı. Tek sorun aralık belirlemiş olduğum kısım:
If Intersect(Target, [b2:b20]) Is Nothing Then Exit Sub
kısmında:
Method 'Intersect' of Object '_Global' ...
hatası veriyor. Oda sanırım 'sh' değişkenini hiç kullanmamış olmamdan. Yani ben bu makronun sadece 1 sayfada çalışmasını istiyorum. Acaba bu sayfayı nasıl tanıttıracağım.. :kafa:

 

[Levent Menteşoğlu]

kod içine aşağıdaki gibi bir satır ekleyin. Kod sadece Sayfa1 de çalışır.

if activesheet.name<>"sayfa1" then exit sub

 

[mith]

Yetti Gari..

Arkadaşlar, kaç gündür uğraşıyorum, bi başaramadım şu meredi. :? Allah rızası için birisi el atsın, kafayı yedirtecek bana. Gerekli tüm açıklamalar ekteki dosyada mevcuttur.
Yardımlarınızı her zamanki gibi esirgemeyin..

 

[Levent Menteşoğlu]

47.hafta sayfasının kod sayfasına aşağıdaki kodu kopyalayın ve diğer kodların tümünü silin. 47.hafta sayfasındaki B2:B15 aralığındaki bir değeri değiştirdiğinizde kod çalışacaktır.

[vb:1:50a3786d91]Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [b2:b15]) Is Nothing Then Exit Sub
For a = 2 To 15
say = WorksheetFunction.CountIf(Sheets("stok").[a2:a65536], Cells(a, 2))
Cells(a, 2).Interior.ColorIndex = xlNone
If say > 0 Then
Cells(a, 2).Interior.ColorIndex = 45
topla = WorksheetFunction.SumIf([b2:b65536], Cells(a, 2), [a2:a65536])
sat = Sheets("TOPLAM_ÜRETİM").[b1:b65536].Find(Cells(a, 2)).Row
Sheets("TOPLAM_ÜRETİM").Cells(sat, 3) = topla
End If
Next
End Sub
[/vb:1:50a3786d91]

 

[mith]

Sn Moderatör;
Verdiğiniz makroyu bendeki ile karıştırarak aşağıdaki makroyu oluşturdum. Geriye son bir adım kaldı. Þimdi hücre değiştiğinde yeni değerin sütündaki toplamını yazıyor, yalnız hücredeki eski değerin -değiştirilmiş olan değer- de toplamının hesaplanması lazım.
"hasan" adını "ali" yaptım ise bütün alileri topluyor. Ama hasanların sütundaki değerlerini toplamıyor. Halbuki azalması lazım.
Yani hücrenin hem değişmeden önceki değerini, hemde değiştikten sonraki değerini toplattırmak istiyorum..
Yardımlarınızı bekliyorum..
Makro:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [b2:b50,f2:f50]) Is Nothing Then Exit Sub
If Target.Value = "" Then
Target.Interior.ColorIndex = xlNone
Exit Sub
End If

say = WorksheetFunction.CountIf(Sheets("stok").[a2:a65536], Target)
If say > 0 Then
Target.Interior.ColorIndex = xlNone
say1 = WorksheetFunction.CountIf(Sheets("TOPLAM_ÜRETİM").[b2:b65536], Target)
If say1 > 0 Then
topla = WorksheetFunction.SumIf([b2:b65536], Target, [a2:a65536])
sat = Sheets("TOPLAM_ÜRETİM").[b2:b65536].Find(Target).Row
Sheets("TOPLAM_ÜRETİM").Cells(sat, 3).Value = topla
Exit Sub
End If

topla = WorksheetFunction.SumIf([b2:b65536], Target, [a2:a65536])
sat = Sheets("TOPLAM_ÜRETİM").[b2:b65536].End(xlDown).Row
Sheets("TOPLAM_ÜRETİM").Cells(sat + 1, 2).Value = Target.Value
Sheets("TOPLAM_ÜRETİM").Cells(sat + 1, 3).Value = topla
Exit Sub

End If
With Target.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
End Sub

 

[mith]

Arkadaşlar yüzdük yüzdük kuyruğuna geldik, son bir aşama kaldı, bu basamağıda atlarsak sanırımki iş bitecek..
Yardımlarınızı bekliyorum..

 

[Levent Menteşoğlu]

Aşağıdaki kodları 47.hafta sayfasının kod sayfasına kopyalayarak deneyin.

[vb:1:18691e88ca]Dim eskitoplam, eskiad

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [b2:b50,f2:f50]) Is Nothing Then Exit Sub
If Target.Value = "" Then
Target.Interior.ColorIndex = xlNone
Exit Sub
End If
say = WorksheetFunction.CountIf(Sheets("stok").[a2:a65536], Target)
If say > 0 Then
Target.Interior.ColorIndex = xlNone
say1 = WorksheetFunction.CountIf(Sheets("TOPLAM_ÜRETİM").[b2:b65536], Target)
If say1 > 0 Then
topla = WorksheetFunction.SumIf([b2:b65536], Target, [a2:a65536])
sat = Sheets("TOPLAM_ÜRETİM").[b2:b65536].Find(Target).Row
Sheets("TOPLAM_ÜRETİM").Cells(sat, 3).Value = topla
Exit Sub
End If
topla = WorksheetFunction.SumIf([b2:b65536], Target, [a2:a65536])
sat = Sheets("TOPLAM_ÜRETİM").[b2:b65536].End(xlDown).Row
Sheets("TOPLAM_ÜRETİM").Cells(sat + 1, 2).Value = Target.Value
Sheets("TOPLAM_ÜRETİM").Cells(sat + 1, 3).Value = topla
Exit Sub
End If
bul = Sheets("TOPLAM_ÜRETİM").[b2:b65536].Find(eskiad).Row
Sheets("TOPLAM_ÜRETİM").Cells(bul, "c") = Sheets("TOPLAM_ÜRETİM").Cells(bul, "c") - eskitoplam
With Target.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
eskiad = Target
eskitoplam = Target.Offset(0, -1)
End Sub
[/vb:1:18691e88ca]