Kod çalışmıyor

[serif11]

Arkadaşlar selam.






Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If flag = 1 Then
If Not IsEmpty(oval) Then
If Not Intersect(Target, Target.Worksheet.Range("J10:J500")) Is Nothing Then
Target.Value = Target.Value + oval
End If
If Not Intersect(Target, Target.Worksheet.Range("L10:L500")) Is Nothing Then
Target.Value = Target.Value + oval
End If
End If
flag = 0
End If
Application.EnableEvents = True
On Error Resume Next
stn = Target.Column
satr = Target.Row
If Not Intersect(Target, [D2200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 1).Select
ElseIf Not Intersect(Target, [E2:E200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 1).Select
ElseIf Not Intersect(Target, [F2:F200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 4).Select
ElseIf Not Intersect(Target, [J2:J200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 2).Select
ElseIf Not Intersect(Target, [L2:L200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr + 1, stn - 8).Select
End If

End Sub

Bu kodlarla, sayfa içerisinde J ve L sütunlarına girdiğim rakamları üstüne topluyor (örneğin J15 hücresinde 5 rakamı varsa aynı hücreye 8 değerini girdiğimde hücre değeri 13 oluyor) ve hücreye veri girip enter tuşuna bastığımda; D-E-F-J ve L hücreleri arasında geziniyordum.

Ben;

If Intersect(Target, Range("D:E")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = Evaluate("=UPPER(""" & Target.Value & """)")
Application.EnableEvents = True

Kodlarını ilave edip aynı sayfanın D ve E sütunlarına girdiğim veriyi büyük harfe çevirmek istedim. Kodlar çalışıyor fakat ya hücre üzerine ilave toplama özelliği ya da enter tuşuna basınca istediğim hücreler arasında gezinme özelliği çalışmıyor. İkinci kodlarımı birinci kodların hangi bölümüne ilave etmeliyim?
Umarım anlatabilmişimdir.
Şimdiden teşekkürler.

 

[yanginci34]

Merhaba; Dosya eklerseniz çok daha iyi olacak.

 

[serif11]

Teşekkür ederim

 

[yanginci34]

Aşağıdaki gibi bir denermisiniz Hocam.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Range("D:E") = Evaluate("=UPPER(""" & Target.Value & """)")
If flag = 1 Then
If Not IsEmpty(oval) Then
If Not Intersect(Target, Target.Worksheet.Range("J10:J500")) Is Nothing Then
Target.Value = Target.Value + oval
End If
If Not Intersect(Target, Target.Worksheet.Range("L10:L500")) Is Nothing Then
Target.Value = Target.Value + oval
End If
End If
flag = 0
End If
Application.EnableEvents = True
On Error Resume Next
stn = Target.Column
satr = Target.Row
If Not Intersect(Target, [D2200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 1).Select
ElseIf Not Intersect(Target, [E2:E200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 1).Select
ElseIf Not Intersect(Target, [F2:F200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 4).Select
ElseIf Not Intersect(Target, [J2:J200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr, stn + 2).Select
ElseIf Not Intersect(Target, [L2:L200]) Is Nothing Then
If Cells(satr, stn) <> "" Then Cells(satr + 1, stn - 8).Select
End If

End Sub

 

[serif11]

Öncelikle ilgi ve emeğinize teşekkür ederim.
Ama hiç bir şekile olmamış.
D10 hücresine veri olarak yb125 yazıp enter tuşuna bastığımda;
D ve E sütunlarını 1 den 65.536. hücreye kadar YB125 yazdı. Diğer özellikler de (hücre üstüne toplama ve hücreler arası gezinme) özelliğini yitirdi.i

 

[yanginci34]

Bunu kodun Private Sub Worksheet_Change(ByVal Target As Range) yazan kısmından sonra ekleyin.
If Intersect(Target, [d:e]) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Target.Value = BuyukHarf(Target.Value)

End Sub tan sonra da bunu ekleyin hocam.

Function BuyukHarf(Veri As String)

BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))

End Function

 

[serif11]

Yok. Hiç bir şekilde iş görmüyor.
Tekrar teşekkür ederim.

 

[serif11]

Yardım lütfen

 

[systran]

If flag = 1 Then
flag kontrolü var ama yukarıdaki kodların hiç bir yerinde flag=1 yapan bir durum görmedim.
aynı şekilde oval ne?
başka modülde falan kod olmasın? tüm kod bu mu?
ben denemelerimde J ve L sütunlarına veri giremedim, sürekli farklı sütunlara atıyor.
elinizdeki verilerden oluşan örnek bi çalışmayı yüklemeniz daha faydalı olacaktır diye düşünüyorum, ben birşey anlamadım.

 

[serif11]

Sayfanın en başında;
Dim oval
Dim flag As Integer
diye kod var

 

[systran]

onlar tanımlama satırları, bu değişkenlerin durumunu değiştiren kodların olduğu bölüm yok!
oval=1
flag=1
gibi
...

 

[serif11]

İçnde flag geçen bir kod gurubu da şöyle :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
flag = 1
If Not Intersect(Target, Target.Worksheet.Range("J10:J500")) Is Nothing Then
oval = Target(1, 1).Value
End If
If Not Intersect(Target, Target.Worksheet.Range("L10:L500")) Is Nothing Then
oval = Target(1, 1).Value
End If
CommandButton1.Enabled = False
CommandButton3.Enabled = True
X = WorksheetFunction.CountA(Range("D10500"))
If X <> 0 Then
CommandButton1.Enabled = True
CommandButton3.Enabled = False
End If



End Sub

 

[serif11]

Biraz da gülelim.

flag=0

satırından sonra;

Target=UCase(Target)
satırını ekledim. İstediğim sonucu aldım.

))))))))