Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Excel'e Yeni Başlayanlar (http://www.excel.web.tr/forumdisplay.php?f=14)
-   -   Kod çalışmıyor (http://www.excel.web.tr/showthread.php?t=163562)

serif1 20-04-2017 07:29

Kod çalışmıyor
 
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, [D2:D200]) 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 20-04-2017 08:17

Merhaba; Dosya eklerseniz çok daha iyi olacak.

serif1 20-04-2017 08:52

Teşekkür ederim

yanginci34 20-04-2017 09:03

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

serif1 20-04-2017 09:32

Ö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 20-04-2017 09:49

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

serif1 20-04-2017 10:06

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

serif1 20-04-2017 12:57

Yardım lütfen

systran 20-04-2017 13:40

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.

serif1 20-04-2017 14:04

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


Saat 13:40

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.