comment kısmında vlookup kullanma ve girdi (duseyara) (Uzmanlık sorusu :) )

[hakan439]

Öncelikle Hamitcan bey' e çok çok teşekkür ederim tüm yardımları için. Ancak sorunu ikimizde çözemedik. Benim yapmak istediğim resimlerde de görüldüğü gibi fatura dosyasında girilen malların kutu içerikleri 20 ile 120 kg arasında değişiyor. bunun için hamitcan bey bana çok yardımcı oldu ve bir ürün girildiğinde, kilogram sütununda bu ürüne ait kutuların Kaçar kilogram olduğu ve stok bilgisi comment box a çıkacak şekilde bir kod hazırladı. Sonra bu kodda ben şöyle bir değişiklik istedim: kilogramın yazıldığı sütuna eger k1 girilirse, ürüne ait kilogram bilgisinin otomatik olarak kg. karşılığına cevrilmesi.

Yani diyelimki girilen ürünün 1 kutusu 30 kg, kullanıcı k5 yazdığı vakit bu hücredeki değer 5 kutu şeklinde algılanıp 150 olcak şekilde değiştirmesi ancak 150 yazarsa bir değişiklik yapmaması.

Hamitcan bey son isteğim için de bir kod gönderdi sağolsun ancak benim excel de bu kod çalışmadı. ben 2003 ing versiyonunu kullanıyorum, hamitcan bey de ise 2007 tr versiyonu var.

Ayrıca 2 resme dikkat ederseiz comment box ların formatları 2. ürünle birlikte değişiyor. ilk comment box tam istediğim gibi ancak sonrakilerin formatları bozuluyor. Bu iki detayda yardımcı olabilecek arkadaşlardan yardım istiyorum. kodu ve ekran görüntüleri aşağıda gönderdim fikir versin diye.

Şu an bendeki çalışan kod. (kutu içeriği otomatik çarpma işlemi yok. format sorunu var)

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 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

Hamitcan Bey in gönderdiği kod ( bende çalışmadı)

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

İlk üründe format istediğim gibi

ondan sonrakilerde hepsi siyah oluyor ve fontlar küçülüyor

 

[hakan439]

yokmu bir el atacak uzman