Bir sayfada iki kodu nasıl çalıştırılır.

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar, aşağıdaki iki kodu bir sayfada nasıl çalıştırırım.
Birinci Kod;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C35:C" & Rows.Count)) Is Nothing Then Exit Sub
Range("B35:B" & Rows.Count).ClearContents
With Range("B35:B" & Cells(Rows.Count, "C").End(3).Row)
.Formula = "=IF(C35="""","""",COUNTA(C$35:C35))"
.Value = .Value
End With
End Sub

İkinci kod;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I16:I40]) Is Nothing Then Exit Sub
If UCase(Target) <> Target Then
Target = Evaluate("=UPPER(" & Target.Address & ")")
End If

Bu iki kodu bir sayfada nasıl çalıştırırım teşekkür ederim.

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C35:C" & Rows.Count)) Is Nothing Then
Range("B35:B" & Rows.Count).ClearContents
With Range("B35:B" & Cells(Rows.Count, "C").End(3).Row)
.Formula = "=IF(C35="""","""",COUNTA(C$35:C35))"
.Value = .Value
End With
End If
If Not Intersect(Target, [I16:I40]) Is Nothing Then
If UCase(Target) <> Target Then
Target = Evaluate("=UPPER(" & Target.Address & ")")
End If
End If
End Sub

 

[Hacı Bayram ÖZKAN]

Teşekkürler abim çok hızlısınız. Dua ile kalın

 

[Hacı Bayram ÖZKAN]

Sayın Seyit Bey; 2 nolu mesajınızda ki çözüm önerinizi aşağıdaki kodlar için yapmaya çalıştım yapamadım efendim buna da yardımcı olur musunuz?

1. Kodlar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B6:B" & Rows.Count)) Is Nothing Then Exit Sub
Range("A6:A" & Rows.Count).ClearContents
With Range("A6:A" & Cells(Rows.Count, "B").End(3).Row)
.Formula = "=IF(B6="""","""",COUNTA(B$6:B6))"
.Value = .Value
End With
End Sub

2. Kodlar;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B6:B" & Rows.Count)) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Value = "" Then Exit Sub
On Error GoTo 0
Range("C" & Target.Row & ":G" & Target.Row).ClearContents

Dim conn As Object, rs As Object
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("adodb.recordset")
syf = "LİSTE": b = 0
For m = 1 To 2
If m = 2 Then syf = "TÜM"
conn.Open ("Provider=microsoft.ace.oledb.12.0;data source=" & "D:\Belgelerim\Personel\" & _
"\PERSONEL LİSTESİ.xlsm;extended properties=""excel 12.0;hdr=yes""")

' "D:\Belgelerim\Görev Yolluğu\" yerine ThisWorkbook.Path yazılırsa aynı klasörün içinde olması gerekiyor.

rs.Open "select * from [" & syf & "$] where Sicili=" & Target.Value & ";", conn, 1, 3
If rs.RecordCount > 0 Then
Cells(Target.Row, "C").Value = rs("Adı").Value
Cells(Target.Row, "D").Value = rs("Soyadı").Value
Cells(Target.Row, "E").Value = rs("Maaş D").Value & "//" & rs("Maaş K").Value
Cells(Target.Row, "F").Value = rs("EK GÖS").Value
Cells(Target.Row, "G").Value = rs("Rütbesi").Value
Else
b = b + 1
End If
If b = 1 Then
rs.Close
conn.Close
Else
Exit For
End If
Next

If b = 2 Then MsgBox "LİSTEDE BU SİCİLE AİT PERSONEL BULUNAMADI"
If b = 2 Then Target.Select
If b = 2 Then Target = ""
End Sub

Teşekkür ederim.

 

[Seyit Tiken]

Biraz dikkatlice bakarsanız nerede hata yaptığınızı bulabilirsiniz.