Makroya Depo ilave

[igultekin2000]

iyi akşamlar; Form sitesi sakinleri yardımıyla çalışma hazırladım. Bir ilave yapmam gerekiyor. Epey denedim yapamadım. Makro A sütunu ve B-BE satırının kesişim yerine tıklandığında İP PERDE çalışma sayfasındak ü ürünün üzerine gidiyor. Bunun yanında aynı üründen , A1 hücresindeki -4142, 6, 44 gibi farklı depoda olabiliyor. Bu seçime A1 hücresindeki Depo seçeneğinide katarak makroyu çalıştırmak istiyorum. Teşekkürler.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Bak As Integer
    Dim Cinsi As String
    Dim Rengi As String
    
  
    Cancel = True
    Cinsi = Cells(Target.Row, "A").Text
    Rengi = Cells(1, Target.Column).Text
    
    
    If Intersect(Target, Range("B:AE")) Is Nothing Or Target.Row = 1 Then Exit Sub
    With Worksheets("İP PERDELER")
        For Bak = 5 To .Cells(Rows.Count, "C").End(3).Row
        Dim i
        i = .Cells(Bak, "B").Text
        i = .Cells(Bak, "C").Text
      
      
            If .Cells(Bak, "B").Text = Cinsi And .Cells(Bak, "C").Text = Rengi Then
                .Activate
                .Cells(Bak, "D").Activate
                Exit Sub
            End If
        Next
    End With
    MsgBox "Cinsi: '" & Cinsi & "' Rengi: '" & Rengi & "' olan kayıt bulunamadı.", vbExclamation
End Sub

 

[Muzaffer Ali]

Daha açık ifade eder misiniz?
Örneğin Sayfa1 de,
"KÜÇÜK PUANLI" ve "CİVCİV SARISI" kesişimini çift tıkladığımda A1 hücresinde "-4142" yazıyorsa ne olmasını istiyorsunuz?

 

[igultekin2000]

Daha açık ifade eder misiniz?
Örneğin Sayfa1 de,
"KÜÇÜK PUANLI" ve "CİVCİV SARISI" kesişimini çift tıkladığımda A1 hücresinde "-4142" yazıyorsa ne olmasını istiyorsunuz?

Kursörün bu satıra gelmesini istiyorum. Şimdiki işlemde -4142 değerlenmediği için kursör satır ve sütundaki ürünle uyuşan satıra gidiryor. oysa anı satır ve sütunda aynı isimide ürünler oluyor sadece renk( depo) ları farklı oluyor.

 

[Muzaffer Ali]

Sayfa4'te bulunan kodları aşağıdakiler ile değiştirin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Bak As Integer
    Dim Cinsi As String
    Dim Rengi As String
    Dim Kod As String
    Cancel = True
    Cinsi = Cells(Target.Row, "A").Text
    Rengi = Cells(1, Target.Column).Text
    Kod = Range("A1").Text
    If Intersect(Target, Range("B:AE")) Is Nothing Or Target.Row = 1 Then Exit Sub
    With Worksheets("İP PERDELER")
        For Bak = 5 To .Cells(Rows.Count, "C").End(3).Row
            If .Cells(Bak, "B").Text = Cinsi And .Cells(Bak, "C").Text = Rengi And .Cells(Bak, "F").Text = Kod Then
                .Activate
                .Cells(Bak, "D").Activate
                Exit Sub
            End If
        Next
    End With
    MsgBox "Cinsi: '" & Cinsi & "' Rengi: '" & Rengi & "' Kodu: '" & Kod & "' olan kayıt bulunamadı.", vbExclamation
End Sub

 

[igultekin2000]

Teşekkür ederim sorunsuz çılışıyor.