comment kısmında vlookup kullanma (duseyara)

[hakan439]

arkadaslar bir fatura programım var. irsaliye kesme sayfasında sırasıyla B sütununda ürün kodu, C sütununda ürün ismi D Sütunuda da kg giriliyor

A B C D
------- ---------------------------------- ---------- -------
325456 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 60 kg

şeklinde. her satılan ürünün kutu miktarları farklı, bir kutusu 60 kg olan ürün de var, 20 kg olan üründe. sevk irsaliyesi olusturulurken ürün ismi listbox tan secildiginde vloopup fonksiyonu ile ürün kodu ve ürünün 1 kutudaki miktarı bilgi A ve C sütünlarına giriliyor. ancak yukarıda örnekte gibi kutu miktarı 60 kg olan bir maldan 10 kutu istenirse ben oaya 600 yazıyorum ve vlookup fonksiyonu siliniyor o satırda. ben de kutu miktarıları giriln ürüne gore C ütununda çıkacagına o hücrenin comment kımısnda cıksın istiyorum. ama tabi bunun sürekli çalışması lazım. yardımlarınızı bekliyorum

 

[hamitcan]

Küçük bir dosya ekleyin ve olması gereken halini dosyada belirtin.

 

[hakan439]

Küçük bir dosya ekleyin ve olması gereken halini dosyada belirtin.

dosyanın bir bolumunu asagıda gonderiyorum. dosya 9,10 pencereden olustugundan toplam boyutu epey fazla. sıkıstırdıgımda bile 2.1 mb oluyor.

 

[hakan439]

yardım edecek yok mu

 

[hamitcan]

Aşağıdaki kodu sayfanın kod kısmına ekleyerek deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [C20:c45]) Is Nothing Then Exit Sub
If Target.Offset(0, -1) > 0 Then
With Target.Offset(0, 1)
    .Comment.Delete
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:=WorksheetFunction.VLookup(Target, [r2:w200], 3, False) & " kg"
End With
End If
End Sub

 

[hakan439]

Aşağıdaki kodu sayfanın kod kısmına ekleyerek deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [C20:c45]) Is Nothing Then Exit Sub
If Target.Offset(0, -1) > 0 Then
With Target.Offset(0, 1)
    .Comment.Delete
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:=WorksheetFunction.VLookup(Target, [r2:w200], 3, False) & " kg"
End With
End If
End Sub

hamitcan bey tesekkur ederim ama tam calısmadı. oncelikle comment ksımına kg. bilgileri gelmedi. ilk 3 satırda comment kutucukları olusturuldu anak içleri bos kaldı. 4 ten sonraki stırlarda ise calısmadı. ikincisi bu sayfada calısan bir kucuk kodum daha vardı size gonderdigim dosyada mevcut olması lazım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [h10]) Is Nothing Then Exit Sub
    kod = [M3]
       
    Application.EnableEvents = False
    If kod <> "" Then kod = 1
    Application.EnableEvents = True
    End Sub

bu kodla calısacak sekilde asıl birlestirebiliriz bunu

 

[hamitcan]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [h10]) Is Nothing Then Exit Sub
    kod = [M3]
       
    Application.EnableEvents = False
    If kod <> "" Then kod = 1
    Application.EnableEvents = True
    End Sub

Bu kod ile ne yapmak istediğinizi belirtir misiniz? Bu koda göre gönderdiğim kod üzerinde değişiklik yapmam gerekiyor.

 

[hakan439]

Bu kod ile ne yapmak istediğinizi belirtir misiniz? Bu koda göre gönderdiğim kod üzerinde değişiklik yapmam gerekiyor.

Sn. Hamitcan bey: kodu su sekilde revize ettim:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, [h10]) Is Nothing Then Exit Sub
kod = [m3]

If [c235] > 0.5 Then
[m3] = 1
Else
End If
Application.EnableEvents = False
If kod <> "" Then kod = 1
Application.EnableEvents = True

End Sub

Hamitcan bey bu kodun oldugu sayfa irsaliye kesilen sayfa. bu kodda yer alan m3 hücresinde tutulan sayı o günkü siparis numaralrı olusturmakta kullanılıyor. bu kodun yaptıgı: irsaliye tarihi ile bugunkü tarihi karsılastırıyor, eger en son kesilen irsaliyenin tarihi bugunden kucukse (yani eskiyse) m3 hücresindeki degeri 1 yapıyor ve bugun kesilmeye baslayan irsaliyeler 1 den numaralndırılmaya baslanıyor. eger en son kesilen irsaliye tarihi ile bugunku tarih aynı ise, bu rakama dokunmuyor ve irsaliye kesildikce bu rakam 1 er arttırılıyor. irsaliye acılıs sayfasında bu kodun calsıması bu nedenle onemli.

 

[hamitcan]

Kodları aşağıdaki şekilde değiştirip dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$H$10" Then
kod = [m3]
If [c235] > 0.5 Then
    [m3] = 1
Else
End If
    Application.EnableEvents = False
    If kod <> "" Then kod = 1
    Application.EnableEvents = True
End If
End Sub
    
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [C20:c45]) Is Nothing Then
If Target.Offset(0, -1) > 0 Then
With Target.Offset(0, 1)
    .Comment.Delete
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:=WorksheetFunction.VLookup(Target, [r2:w200], 3, False) & " kg"
End With
End If
End If
End Sub

 

[hakan439]

Kodları aşağıdaki şekilde değiştirip dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$H$10" Then
kod = [m3]
If [c235] > 0.5 Then
    [m3] = 1
Else
End If
    Application.EnableEvents = False
    If kod <> "" Then kod = 1
    Application.EnableEvents = True
End If
End Sub
    
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [C20:c45]) Is Nothing Then
If Target.Offset(0, -1) > 0 Then
With Target.Offset(0, 1)
    .Comment.Delete
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:=WorksheetFunction.VLookup(Target, [r2:w200], 3, False) & " kg"
End With
End If
End If
End Sub

Hamitcan bey, kodunuzu denedim simdi. Kısmen calısıyor ancak benim kısım maalesef calısmıyor. sizin hazırladıgınız kısım tam istedigim gibi calısıyor, lakin 2 küçük detayda daha bana yardımcı olmanızı rica edicem sizden. Gerci ben kısmen yaptım ama istedigim formata getiremedim. asagıda nasıl olmasını istedigimi anlıyacaksınız sanırım. Ben su kadar yapabildim;

"10 kg Stok durumu: 50 kg."

şeklinde gösterecek sekilde ekleme yaptım sizin gonderdiginiz koda ancak bir satır asagısına belirli büyüklükte yazdırmayı ve direk kalan stok miktarını kutu adedine cevirmeyi yaptıramadım. asagıda ki resim olmasını istedigim format


Ekli dosyayı görüntüle 28643

 

[hamitcan]

Stok durumunu nasıl tespit ediyorsunuz ?

 

[hakan439]

Stok durumunu nasıl tespit ediyorsunuz ?

stok durumu tablodan alınıyor direk. sizin kodunuza ilaveten su kodla stok bilgisini alıyorum.

WorksheetFunction.VLookup(Target, [r2:w200], 6, False)

 

[hamitcan]

Kodu aşağıdaki şekilde değiştirir misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
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
    .Comment.Text Text:=kg & " kg" & Chr(10) & "Stok Durumu:" & Chr(10) & stok & " kg" & "(" & kutu & ")" & " kutu"
End With
End If
End If
End Sub

 

[hakan439]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
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 = False
    .Comment.Text Text:=kg & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu" & ")"
End With
End If
End If
End Sub

Hamitbey su font büyüklügünü ve renklerini de ayarlamamda yardıcmı olursanız bitecek su sekilde biraz degistirdim yine;
(1) kutu yerine artık
(1 kutu) şeklinde görülüyor. ancak "Stok durumu" yazısınının rengini, font büyüklügünü ve bold karakter yapmayı degistremedim. birde benim bastaki kodu nasıl eklicez, su siparis kodu üreten kısmı?

 

[hakan439]

Kodu aşağıdaki şekilde değiştirir misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
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
    .Comment.Text Text:=kg & " kg" & Chr(10) & "Stok Durumu:" & Chr(10) & stok & " kg" & "(" & kutu & ")" & " kutu"
End With
End If
End If
End Sub

Düzeltillmiş kod:

On Error Resume Next
If [c235] > 0.5 Then
[m3] = 1
End If


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 = False
    .Comment.Text Text:=kg & " kg" & Chr(10) & Chr(10) & "Stok Durumu: " & Chr(10) & stok & " kg " & "(" & kutu & " kutu" & ")"
End With
End If
End If
End Sub

Hamitcan Bey; geriye sadece font büyüklügü ve bazı yerlerin rengini ayarlamak kaldı. yukarıda ki kodu şu sekilde degistirdim hersey calısıyor simdi su Kozmetik degisiklikler konusunda da bana yardımcı olurmusunuz son kez?

 

[hamitcan]

geriye sadece font büyüklügü ve bazı yerlerin rengini ayarlamak kaldı.

Nereyi kastediyorsunuz ?

su Kozmetik degisiklikler konusunda da bana yardımcı olurmusunuz son kez?

Burayı anlamadım.

 

[hakan439]

Nereyi kastediyorsunuz ?

Burayı anlamadım.

Hamitbey comment box ın su sekilde gorunmesini istiyorum.
Ekli dosyayı görüntüle 28716

font buyuklugunun 10 olmasını ve bold karakter olmasını; "stok durumu" yazısının bold karakterlerle ve kırmızı renkle gorunmesini istiyorum. demek istedigim uydu

 

[hamitcan]

Aşağıdaki şekilde dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
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
    .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
End With
End If
End If
End Sub

 

[hakan439]

Aşağıdaki şekilde dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
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
    .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
End With
End If
End If
End Sub

Hamitcan Bey; şöyle bir sorun yaşıyorum, ilk satırda calısıyor, sonraki satırlarda ürün adının yazıldıgı kısmı (solundaki hücreyi) bold yapıyor ve comment box ise Font 8 oluyor ve siyah kalıyor. Comment box larda ekranda sabit göründükleri için listeye asagıya dogru 3, 4 kalem ürün girildiğinde kilogramların yazıldıgı her hücrede bir comment box acılıyor ve aradakilere ulasmak zor oluyor. Ben onun yerine kodun su satırını degistirdim;

 .Comment.Visible = false

şimdi sadece kilogram girmek istedigimde; kilogramın oldugu hücrenin üzerine gelince cıkıyor comment boxlar ama bu seferde tüm font 8 oluyor ve ince karakter oluyor. asagıda 3 durumdaki halini gonderiyorum

1) sizin gonderdiginiz kodu oldugu gibi kullandıgımda ilk satır
Ekli dosyayı görüntüle 28755


2) sizin kodu kullanarak birden fazla ürün girdigimde
Ekli dosyayı görüntüle 28756

3) sizin gonderdiginz kodda

 .Comment.Visible = True

olan kısmı ben su sekilde degistirdim.

 .Comment.Visible = false

simdi comment box lar sadece imlec ürünlerin miktarının girildigi hücrenin üzerinde geldiginde gorunuyor. boylece görüntü kirliligi olmuyor.

Ekli dosyayı görüntüle 28757

 

[hamitcan]

Hamitcan Bey; şöyle bir sorun yaşıyorum, ilk satırda calısıyor, sonraki satırlarda ürün adının yazıldıgı kısmı (solundaki hücreyi) bold yapıyor ve comment box ise Font 8 oluyor ve siyah kalıyor.

Ben de böyle bir hata vermedi.

simdi comment box lar sadece imlec ürünlerin miktarının girildigi hücrenin üzerinde geldiginde gorunuyor. boylece görüntü kirliligi olmuyor

Evet burada yaptığınız düzeltme güzel olmuş. Eski haliyle kalsaydı, üstteki açıklamalar görünmeyecekdi.