comment kısmında vlookup kullanma (duseyara)

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
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
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
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; 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.

benim kendi dosyama kopyaladım oldugu gibi kodunuzu, ordada ik satırda mukemmel calıstı. sonrakilerde font 8 ve tüm karakterler bold cıkıyor. ayrıca renk kısmı da calısmadı. baktım ama düzeltlecek bisi bulamadım da. bir yerde bisi var ama anlamadım nerdenkaynaklandıgını. ama sanıırm bu kadar olcak. sizide daha fazla ugrastımak istemiyorum.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
Sayın hakan439, kodları tekrar denedim. Ama bahsettiğiniz hatalarla karşılaşmadım.
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Sayın hakan439, kodları tekrar denedim. Ama bahsettiğiniz hatalarla karşılaşmadım.
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.

Sizden bir konuda daha yardımcı olmanızı istiyorum. buda dün yasadıgım bir durumdu ve hata yapma olasılıgını azaltır diye istiyorum. dün simdi yüklü bir sipariş alınmıs. ancak siparis verenler "su kadar kutu" olarak siparis veriyor biz irsaliyelere kg karsılıklarını yazıyoruz. dün yüklü bir siparişte, kafadan yapılan bir hesap yüzüden bir karısılık oldu. ben soyle bir ek daha yapmak istiyorum. kg. girildigi hücreye k ile baslayan birsey girildigide rakamı kutu adediyle carpsın. soyleki:

300 girersem bu 300 kg olarak alsın. ama k10 girersem bu ürünün kutu miktarını 10 ile carpıp otomatik girsin( örn. 25kilogramlık kutu ise; k10 girdigimde 250 oalrak cıksın). bunu yapmak da mümkün mü?
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
ü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.
Kod:
If Target.Count > 1 Then Exit Sub
satırını kodun üst kısmına ekleyin.
Diğer sorunuz için ise, dosya içinde örnekle anlatmanızı isteyeceğim. Çünkü en hızlı ve net bu şekilde cevap veriliyor.
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Kod:
If Target.Count > 1 Then Exit Sub
satırını kodun üst kısmına ekleyin.
Diğer sorunuz için ise, dosya içinde örnekle anlatmanızı isteyeceğim. Çünkü en hızlı ve net bu şekilde cevap veriliyor.
Sn. Hamitcan İŞ gezisi sebeiye şehir dışındaydım. son istediğim değişiklik için dosyayı tekrar gönderiyorum. teşekkürler
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
Ben konuyu unuttum. Bir kutu kaç kilograma eşitdi ?
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Sn. Hamitcan

KOnuyu kısaca hatırlatayım: üstteki mesajımda eklemiş olduğum dosya ya bakabilirseniz belki hatırlarsınız. Sorunum şu idi: 150 çeşit ürün var listede ve bu ürünlerin kutu miktarları farklı farklı. 20 kg olan da var, 120 kg olanda. Sizden soyle bir yardım almıstım:

excel tablosunda bir sütunda ürünler giriliyor, bunun yanındaki sütüna da kg. cinsiden miktarları giriliyor. sizin yardımınızla seçilen ürüne göre, o ürüne ait kutu miktarı; kg. yazılan hücrein comment box ında görülüyor. kod da soyle idi:

Kod:
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
ben simdi buna soyle bir sey istiyorum. 30 girilirse bu 30 kg olarak, eger k1 girilmiş ise kutu miktarının otomatik olarak yazılmasını istiyorum. k4 olursa 4 kutu (örn. eger kutu 30 kg luk ise 120 yazacak) kac kilogram tutarsa o yazılcak
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
kutu miktarları değişiyor. bu yüzden vlookup ile bakıyor ve comment box a yazdırıyorduk kutu mikytarları ve kalan stok durumunu. benim istediğim kilogramların yazıldıgı hücrede k ile başlayan bişi gordugunde k nın yanındaki sayıyı (örn: k4 oldugunda 4, yada k11 oldugunda 11 i) o ürününü kutu miktarı ile carpıp kg. hücresine yazması. aslında sizin gonderdiginiz kodda buna benzer bi satır var ama beceremedim uyarlamayı
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
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
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Maalesef kod hiç çalışmadı. size fatura programının orjinalini gönderiyorum. 800 kb oldugu için sıkıstırdım. Eğer bir göz atabilirseniz ve kodda yapmak istediğim değişiklikler konusunda yardımcı olabilirseniz çok sevinirim.

iyi çalışmalar dilerim


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
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
Aş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
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Aş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
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 üzerinde
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,738
Excel Vers. ve Dili
Excel 2019 Türkçe
Öncelikle verdiğiniz dosyayı en son verdiğim kodlar ile denedim doğru çalışıyor, bunu belirtmek isterim.
Bunun haricinde size tavsiyem verdiğim kodları "irsaliye" sayfasının kod kısmına eklemeniz, ve de tabii ki de ilk açılışta makroları etkinleştirmeniz. Bunun haricinde aklıma şu anda fazla birşey gelmiyor doğrusu.
 
Katılım
1 Mart 2007
Mesajlar
72
Excel Vers. ve Dili
2003 ingilizce
Sn. Hamitcan

Tam da dediğinizi yapıyorum. ancak k1 yazınca k1 olarak kalıyor. kg verisine cevirmiyor. Ayrıca comment boxlar daki degerlerde aynı kalıyor. secilen ürüne gore degişmiyor. Belki benim excel de bir sorun vardır ama sizin gonderdginiz kodu aynen girdim. ancak çalıştıramadım. açılışta macrolar enable şeklinde ayarlı. hepsi aktif olarak çalışıyor. Artık boyle kullnacagım. sizi de fazla ugrastırmak istemiyorum, zaten yeterince uğraştınız benim için. Eger siz benim gonderdiğim dosyada denediniz ve calısıyor diyorsanız benim excel de bir sorun olabilir dicem ama bende de şimdiye kadar herşey düzgün çalıştı. siz o daosyayı bana e-mail ile gonderirmisiniz? aydogan019@gmail.com. teşekkür ederim
 
Üst