Dosyayı gonderiyorum. bir goz atabilirseniz sevinirim.Ben de böyle bir hata vermedi.
Evet burada yaptığınız düzeltme güzel olmuş. Eski haliyle kalsaydı, üstteki açıklamalar görünmeyecekdi.
Ekli dosyayı görüntüle 28800
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dosyayı gonderiyorum. bir goz atabilirseniz sevinirim.Ben de böyle bir hata vermedi.
Evet burada yaptığınız düzeltme güzel olmuş. Eski haliyle kalsaydı, üstteki açıklamalar görünmeyecekdi.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan
If [c235] > 0.5 Then
[m3] = 1
End If
'----------------------------------------------------------
'--sizin gonderdiginiz kod:--------------------------------
If Not Intersect(Target, [C20:c45]) Is Nothing Then
If Target.Offset(0, -1) > 0 Then
kg = WorksheetFunction.VLookup(Target, [r2:w200], 3, False)
stok = WorksheetFunction.VLookup(Target, [r2:w200], 6, False)
kutu = WorksheetFunction.VLookup(Target, [r2:w200], 6, False) / WorksheetFunction.VLookup(Target, [r2:w200], 3, False)
With Target.Offset(0, 1)
.Comment.Delete
.AddComment
.Comment.Visible = True 'burayı degıstırdım
.Comment.Text Text:=kg & " kg" & Chr(10) & "Stok Durumu:" & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
.Comment.Shape.Select
With Selection
.Font.Bold = True
.Font.Size = 10
.Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3
End With
.Comment.Visible = False
End With
End If
End If
End Sub
Hamitcan Bey; 10-15 tane ürün girdim. sorunsuz calıstı, ancak bu girilen ürünleri silince tüm satırları bold yaptı. sonra da comment box lar ilk zamanki haline dondu.Kodu aşağıdaki şekilde değiştirdim.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next 'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan If [c235] > 0.5 Then [m3] = 1 End If '---------------------------------------------------------- '--sizin gonderdiginiz kod:-------------------------------- If Not Intersect(Target, [C20:c45]) Is Nothing Then If Target.Offset(0, -1) > 0 Then kg = WorksheetFunction.VLookup(Target, [r2:w200], 3, False) stok = WorksheetFunction.VLookup(Target, [r2:w200], 6, False) kutu = WorksheetFunction.VLookup(Target, [r2:w200], 6, False) / WorksheetFunction.VLookup(Target, [r2:w200], 3, False) With Target.Offset(0, 1) .Comment.Delete .AddComment .Comment.Visible = True 'burayı degıstırdım .Comment.Text Text:=kg & " kg" & Chr(10) & "Stok Durumu:" & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")" .Comment.Shape.Select With Selection .Font.Bold = True .Font.Size = 10 .Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3 End With .Comment.Visible = False End With End If End If End Sub
Hamitcan bey ürünleri tek tek silince dediginiz gibi bir sorun yok. ama 3-4 satırı secip toplu sildiginizde bold yapıyor olması lazım. ben de oole oluyor cunku. ben tekrar en sona o kısmı normale dondurmek icin bir satır ekledim ama buna ragmen 2-3 satırı birden secip toplu halde silince yapıyor. neyse cok onemli degil zaten.Sayın hakan439, kodları tekrar denedim. Ama bahsettiğiniz hatalarla karşılaşmadım.
ürünleri tek tek silince dediginiz gibi bir sorun yok. ama 3-4 satırı secip toplu sildiginizde bold yapıyor olması lazım. ben de oole oluyor cunku.
If Target.Count > 1 Then Exit Sub
Sn. Hamitcan İŞ gezisi sebeiye şehir dışındaydım. son istediğim değişiklik için dosyayı tekrar gönderiyorum. teşekkürlersatırını kodun üst kısmına ekleyin.Kod:If Target.Count > 1 Then Exit Sub
Diğer sorunuz için ise, dosya içinde örnekle anlatmanızı isteyeceğim. Çünkü en hızlı ve net bu şekilde cevap veriliyor.
On Error Resume Next
'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan
If [c235] > 0.5 Then
[m3] = 1
End If
'----------------------------------------------------------
'--sizin gonderdiginiz kod:--------------------------------
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C20:c45]) Is Nothing Then
If Target.Offset(0, -1) > 0 Then
Liste = WorksheetFunction.VLookup(Target, [c20:d45], 3, False)
kg = WorksheetFunction.VLookup(Target, [r2:w200], 3, False)
stok = WorksheetFunction.VLookup(Target, [r2:w200], 6, False)
kutu = WorksheetFunction.VLookup(Target, [r2:w200], 6, False) / WorksheetFunction.VLookup(Target, [r2:w200], 3, False)
With Target.Offset(0, 1)
.Comment.Delete
.AddComment
.Comment.Visible = True 'burayı degıstırdım
.Comment.Text Text:=kg & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
.Comment.Shape.Select
With Selection
.Font.Bold = True
.Font.Size = 10
.Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3
End With
.Comment.Visible = False
Liste.Font.Bold = False
End With
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan
If [c235] > 0.5 Then
[m3] = 1
End If
'----------------------------------------------------------
'--sizin gonderdiginiz kod:--------------------------------
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [e20:e45]) Is Nothing Then Exit Sub
If Target.Offset(0, -2) > 0 Then
With Target.Offset(0, -2)
Liste = WorksheetFunction.VLookup(.Text, [C20:d45], 3, False)
kg = WorksheetFunction.VLookup(.Text, [r2:w200], 3, False)
stok = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False)
kutu = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) / WorksheetFunction.VLookup(.Text, [r2:w200], 3, False)
End With
With Target
.Comment.Delete
.AddComment
.Comment.Visible = True 'burayı degıstırdım
If Left(.Text, 1) = "k" Then
.Comment.Text Text:=Right(.Text, Len(.Text) - 1) * WorksheetFunction.VLookup(Target.Offset(0, -2), [r2:w200], 3, False) & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
Else
.Comment.Text Text:=kg & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
End If
.Comment.Shape.Select
With Selection
.Font.Bold = True
.Font.Size = 10
.Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3
End With
.Comment.Visible = False
Liste.Font.Bold = False
End With
End If
End Sub
Son isteğiniz, bütün kodun değişmesine neden oldu. Umarım bir yeri atlamamışımdır. Bu isteğinizde olmuşsa, konuyu kitlemeyi düşünüyorum. Çünkü işin detayı arttıkça hata oluşumu da artıyor.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next 'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan If [c235] > 0.5 Then [m3] = 1 End If '---------------------------------------------------------- '--sizin gonderdiginiz kod:-------------------------------- If Target.Count > 1 Then Exit Sub If Intersect(Target, [e20:e45]) Is Nothing Then Exit Sub If Target.Offset(0, -2) > 0 Then With Target.Offset(0, -2) Liste = WorksheetFunction.VLookup(.Text, [C20:d45], 3, False) kg = WorksheetFunction.VLookup(.Text, [r2:w200], 3, False) stok = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) kutu = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) / WorksheetFunction.VLookup(.Text, [r2:w200], 3, False) End With With Target .Comment.Delete .AddComment .Comment.Visible = True 'burayı degıstırdım If Left(.Text, 1) = "k" Then .Comment.Text Text:=Right(.Text, Len(.Text) - 1) * WorksheetFunction.VLookup(Target.Offset(0, -2), [r2:w200], 3, False) & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")" Else .Comment.Text Text:=kg & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")" End If .Comment.Shape.Select With Selection .Font.Bold = True .Font.Size = 10 .Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3 End With .Comment.Visible = False Liste.Font.Bold = False End With End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan
'If [c235] > 0.5 Then
'[m3] = 1
'End If
'----------------------------------------------------------
'--sizin gonderdiginiz kod:--------------------------------
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [e20:e45]) Is Nothing Then Exit Sub
If Target.Offset(0, -2) > 0 Then
With Target.Offset(0, -2)
'Liste = WorksheetFunction.VLookup(.Text, [C20:d45], 3, False)
kg = WorksheetFunction.VLookup(.Text, [r2:w200], 3, False)
stok = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False)
kutu = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) / WorksheetFunction.VLookup(.Text, [r2:w200], 3, False)
End With
With Target
.Comment.Delete
.AddComment
.Comment.Visible = True 'burayı degıstırdım
If Left(.Text, 1) = "k" Then
.Comment.Text Text:=Right(.Text, Len(.Text) - 1) * WorksheetFunction.VLookup(Target.Offset(0, -2), [r2:w200], 3, False) & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
Else
.Comment.Text Text:=.Text & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")"
End If
.Comment.Shape.Select
With Selection
.Font.Bold = True
.Font.Size = 10
.Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3
End With
.Comment.Visible = False
' Liste.Font.Bold = False
End With
End If
End Sub
verdiğiniz kodu denedim ancak yine çalışmadı (yada ben calıstıramadım). hatta ilk satırdan sonra diger satırlarda da comment box lar hep aynı seyi gosteriyor. ürünlerin bilgilerini vermiyor, hep aynı seyi gosteriyor. siz birde deneyebilirmisiniz benim gönderdiğim dosyam üzerindeAşağıdaki şekilde deneyin.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) 'On Error Resume Next 'Benim ekledigm kısım, siparis kodu uretmek icin kullanılan 'If [c235] > 0.5 Then '[m3] = 1 'End If '---------------------------------------------------------- '--sizin gonderdiginiz kod:-------------------------------- If Target.Count > 1 Then Exit Sub If Intersect(Target, [e20:e45]) Is Nothing Then Exit Sub If Target.Offset(0, -2) > 0 Then With Target.Offset(0, -2) 'Liste = WorksheetFunction.VLookup(.Text, [C20:d45], 3, False) kg = WorksheetFunction.VLookup(.Text, [r2:w200], 3, False) stok = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) kutu = WorksheetFunction.VLookup(.Text, [r2:w200], 6, False) / WorksheetFunction.VLookup(.Text, [r2:w200], 3, False) End With With Target .Comment.Delete .AddComment .Comment.Visible = True 'burayı degıstırdım If Left(.Text, 1) = "k" Then .Comment.Text Text:=Right(.Text, Len(.Text) - 1) * WorksheetFunction.VLookup(Target.Offset(0, -2), [r2:w200], 3, False) & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")" Else .Comment.Text Text:=.Text & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu " & ")" End If .Comment.Shape.Select With Selection .Font.Bold = True .Font.Size = 10 .Characters(WorksheetFunction.Search("S", .Text), 13).Font.ColorIndex = 3 End With .Comment.Visible = False ' Liste.Font.Bold = False End With End If End Sub