+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması (/konu-birden-fazla-private-sub-worksheet-selectionchange-kullanilmasi.html)
Sayfalar:
1
2
Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - HORZUM - 13/04/2023
İYİ GÜNLER ÜSTADLARIM. AŞAĞIDAKİ KODU ÇALIŞTIRAMADIM...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bul As Range
Dim trh As Date
Dim CsutunTarih As Date
With ThisWorkbook.Sheets("T1")
If (Target.Column = 3 Or Target.Column = 5) And Target.Row >= 1 Then
If IsDate(Cells(Target.Row, "c")) And Len(Cells(Target.Row, "E") & "") > 0 Then
SonStn = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)
Set kaydir = .Range("A:A").Find(Cells(Target.Row, "E").Value, , , 1)
If (Not bul Is Nothing) And (Not kaydir Is Nothing) Then Cells(Target.Row, "F").Value = .Cells(kaydir.Row, bul.Column).Value
End If
End If
End With
Set bul = Nothing
If Target
On Error Resume Next
Dim X As Long, No As Long
If Intersect(Target, Range("B2:B65536")) Is Nothing Then ' B2 koşulun Hangi Hücrede başlasın'
Target.Offset(0, -1).Font.Color = vbRed ' Rekli Sayı Verir'
Application.ScreenUpdating = False
For X = 2 To Selection.SpecialCells(xlCellTypeLastCell).Row 'x=2 koşulun Hangi Hücrede başlasın'
If Cells(X, "A").MergeArea.Count = 1 Then
If Cells(X, "B") <> "" And Cells(X, "A") <> "Sıra No" Then
No = No + 1
Cells(X, "A") = No
Else
If Cells(X, "A") <> "Sıra No" Then
Cells(X, "A").ClearContents
End If
End If
End If
Next
Application.ScreenUpdating = True
End Sub
RE: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - berduş - 13/04/2023
Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok
RE: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - HORZUM - 13/04/2023
(13/04/2023, 12:38)berduş yazdı: Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok
Emli dosyada if target i iptal ederek denedim yine olmadı
(13/04/2023, 12:45)HORZUM yazdı:(13/04/2023, 12:38)berduş yazdı: Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok
Ekli dosyada if target i iptal ederek denedim yine olmadı
RE: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - berduş - 13/04/2023
kodunuzun başına Application.EnableEvents = False , sonuna da Application.EnableEvents = true eklemeyi dener misiniz?
kullandığınız Cells(X, "A").ClearContents kodu A sütunundaki veriyi değiştirdiğinden kod Worksheet_Change kodunu 2 kez bu sefer A sütunundaki hücre üzerinden çalıştırıyor
Target.Offset(0, -1) buradaki -1 ifadesi A sütunundan önceki sütunu bulmaya çalışıyor ama bu hataya sebep oluyor
RE: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - HORZUM - 13/04/2023
(13/04/2023, 13:36)berduş yazdı: kodunuzun başına Application.EnableEvents = False , sonuna da Application.EnableEvents = true eklemeyi dener misiniz?
kullandığınız Cells(X, "A").ClearContents kodu A sütunundaki veriyi değiştirdiğinden kod Worksheet_Change kodunu 2 kez bu sefer A sütunundaki hücre üzerinden çalıştırıyor
Target.Offset(0, -1) buradaki -1 ifadesi A sütunundan önceki sütunu bulmaya çalışıyor ama bu hataya sebep oluyor
Hata halloldu ama B sutununa veri girince sıra no yu otomatik atmıyor. Ayrıca b sutunundaki veriyi silince Cells(X, "A").ClearContents çalışmıyor. üst kısımdaki
Dim bul As Range
Dim trh As Date
Dim CsutunTarih As Date
With ThisWorkbook.Sheets("T1")
If (Target.Column = 3 Or Target.Column = 5) And Target.Row >= 1 Then
If IsDate(Cells(Target.Row, "c")) And Len(Cells(Target.Row, "E") & "") > 0 Then
SonStn = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)
Set kaydir = .Range("A:A").Find(Cells(Target.Row, "E").Value, , , 1)
If (Not bul Is Nothing) And (Not kaydir Is Nothing) Then Cells(Target.Row, "F").Value = .Cells(kaydir.Row, bul.Column).Value
End If
End If
End With
Set bul = Nothing
kodunu silince normal çalışıyor
RE: Birden Fazla Private Sub Worksheet_Selectionchange Kullanılması - berduş - 13/04/2023
ilk mesajınızda açıklama yapmadınız, kodun ne yapması gerektiğinden bahsetmediniz sadece çalışmıyor dediniz ben de hatayı düzelttim.
ayrıca kabalığınızı da anlamıyorum, karşınızda uşağınız yada emir eriniz yok.
o kadar emek ve zaman harcıyoruz en azından, işinize yaramasa bile, bir teşekkür hak ediyoruz.