• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kodları birleştirmek istiyorum

G

gedavet

Katılım
15 Eylül 2007
Mesajlar
1,312
Excel Vers. ve Dili
2013 türkçe
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wrksht As Worksheet
Dim objListObj As ListObject
Set wrksht = ActiveWorkbook.Worksheets("Sayfa1")
Set objListObj = wrksht.ListObjects(1)
objListObj.ShowTotals = True
If Target.Row = objListObj.TotalsRowRange.Row - 1 Then
Application.EnableEvents = False
Target.ListObject.ListRows.Add (Target.Row - 1)
Application.EnableEvents = True
End If
End Sub

yukarıdaki kod işimi görüyor teşekkür ederim ancak aşağıdaki kod var dosyamda aşağıdaki kodda çalışması lazım ikisi nasıl birleştiririz aynı başlıkta olunca

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Son_Satır As Long
Son_Satır = Range("B65536").End(3).Row
ActiveSheet.Shapes("Grup 1").Top = Cells(Son_Satır + 2, 2).Top

If Target.Column = 2 Or Target.Column = 5 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
End If

If Target.Column = 3 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If

End Sub
 
Iyi günler bu iki kodda tek başına olduğu zaman çalışıyor başlıkları aynı olduğu için beraber bir sayfaya yapıştırınca çalışmıyor nasıl birleştirilebilir yardımlarını bekliyorum teşekkürler
 
merhaba

kodlarınızı; kod_1 ve kod_2 gibi düşünürsek; bu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
kod_1
kod_2
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
kod_1
Dim wrksht As Worksheet
Dim objListObj As ListObject
Set wrksht = ActiveWorkbook.Worksheets("Sayfa1")
Set objListObj = wrksht.ListObjects(1)
objListObj.ShowTotals = True
If Target.Row = objListObj.TotalsRowRange.Row - 1 Then
Application.EnableEvents = False
Target.ListObject.ListRows.Add (Target.Row - 1)
Application.EnableEvents = True
End If
End Sub

kod_2

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Son_Satır As Long
Son_Satır = Range("B65536").End(3).Row
ActiveSheet.Shapes("Grup 1").Top = Cells(Son_Satır + 2, 2).Top

If Target.Column = 2 Or Target.Column = 5 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
End If

If Target.Column = 3 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If

End Sub


bu şekilde doğrumudur
 
iyi çalışmalar excel hocalarım bana bir yardımcı olurmusunuz kodlar işimi görüyor sadece bu iki kodda çalışmasını istiyorum
 
merhaba
Private Sub Worksheet_Change(ByVal Target As Range)
kod_1
kod_2
End Sub

dikkat ederseniz sadece 1 adet Private Sub Worksheet_Change(ByVal Target As Range)
ve End Sub var.
kodları bu araya öncelik sırasına göre yazmalısınız.
 
Private Sub Worksheet_Change(ByVal Target As Range)
kod_1
Dim wrksht As Worksheet
Dim objListObj As ListObject
Set wrksht = ActiveWorkbook.Worksheets("Sayfa1")
Set objListObj = wrksht.ListObjects(1)
objListObj.ShowTotals = True
If Target.Row = objListObj.TotalsRowRange.Row - 1 Then
Application.EnableEvents = False
Target.ListObject.ListRows.Add (Target.Row - 1)
Application.EnableEvents = True
End If
kod_2
Dim Son_Satır As Long
Son_Satır = Range("B65536").End(3).Row
ActiveSheet.Shapes("Grup 4").Top = Cells(Son_Satır + 2, 2).Top

If Target.Column = 7 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
End If

If Target.Column = 4 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If

End Sub

bu şekilde yaptım yine hata veriyor
 
iyi çalışmalar bana bir yardımcı olan olsa çok iyi olacak
 
Merhabalar,
bu kodları uygulamaya çalıştığınız sayfayı içeren dosyayı eklerseniz, belki daha fazla ilgilenen olacaktır, saygılar.
 
Sayfanızdaki Worksheetchange olay kodunun içindekileri silip aşağıdaki kodları kopyalayıp denermisiniz? ,saygılar.


Kod: 
Dim wrksht As Worksheet
Dim objListObj As ListObject
Set wrksht = ActiveWorkbook.Worksheets("ALIŞ")
Set objListObj = wrksht.ListObjects(1)
objListObj.ShowTotals = True
If Target.Row = objListObj.TotalsRowRange.Row - 1 Then
Application.EnableEvents = False
Target.ListObject.ListRows.Add (Target.Row - 1)
Application.EnableEvents = True
End If

    Dim Son_Satır As Long
    Son_Satır = Range("B65536").End(3).Row
    ActiveSheet.Shapes("Grup 1").Top = Cells(Son_Satır + 2, 2).Top
    
If Target.Column = 2 Or Target.Column = 5 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
End If

If Target.Column = 3 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
 
ilginiz için teşekkür ederim ancak dosyamı 2007 de açınca hata veriyor bu konu şu başlıktan geliyor 2007 de alttaki satırlara veri yazınca satır ekleme kodu var o kodu eski çalışmamdaki kod ile birleştiremk istiyorum ve bu çalışmayı 2003 dede kullansam 2007 dede kullansam çalışmasını istiyorum

http://www.excel.web.tr/showthread.php?t=84691
 
2007 de açınca
Target.ListObject.ListRows.Add (Target.Row - 1)
bu kodda hata veriyor sarı renkle boyuyor
 
iyi günler baştaki satır ekleme kodu 2007 de tek başına çalışıyor diğer kodla birleştirince 2007 de çalışmıyor 2003 de çalışıyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst