Tıkla Aktar

[irfancantr]

tıkla aktar ile ilgili bir sıkıntım var yardımcı olursanız çok sevinirim.Yeterli makro bilgim olmadığı için kilitlendim .
Sorunumu ekteki dosyada detaylı olarak yazdım....

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

 

[irfancantr]

özür dilerim rar dosyayı açamıyorum sıkıştırılmış olarak yada normal bir şekilde atabilirmisiniz sayfaya sayın COST_CONTROL ???

 

[Recep İpek]

Alternatif olarak ekteki dosyayı inceleyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set alan = Application.Union([c6:c15], [g6:g15], [k6:k15], [o6:o15], [s6:s15], [c18:c27], [g18:g27], [k18:k27], [o18:o27], [s18:s27])
If Intersect(Target, alan) Is Nothing Then Exit Sub
Cancel = True
Set bul = [w5:w49].Find(Target, , , xlWhole)
    If Not bul Is Nothing Then
        adet = Cells(bul.Row, "x").Value
        Cells(bul.Row, "x").Value = Target.Offset(0, 1).Value + adet
    Else
        sat = [w50].End(3).Row + 1
            If sat = 50 Then
                MsgBox "Tablo Tamamlandı"
                GoTo Son
            End If
        Cells(sat, "w").Value = Target.Value
        Cells(sat, "x").Value = Target.Offset(0, 1).Value
    For Each renk In alan
    If renk.Value = Target.Value Then renk.Interior.ColorIndex = 6
    Next
    End If
Target.Interior.ColorIndex = 6
Son:
Set alan = Nothing
Set bul = Nothing
Set bul1 = Nothing
Exit Sub
End Sub

 

[irfancantr]

çok teşekkür ederim,çok güzel olmuş ellerinize sağlık . peki rakamı; ilk seçtiğim hücre değerinde bulunanı atıyor gözüküyor,bunu toplam listede nekadar bulunuyorsa atamak mümkün müdür? Çünkü seçtiğim hücreyi ikiden fazla tıklarsam eğer üzerine tekrar bir toplam gerçekleştiriyor...Ama zor bir işlemse uğraşmanızı istemem çok teşekkürler tekrar sağolun elinize sağlık...

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı yeniledim. İncelermisiniz.

 

[Recep İpek]

gözüküyor,bunu toplam listede nekadar bulunuyorsa atamak mümkün müdür? ...

Burasını pek anlayamadım.Bir işlemde o kalemin tüm sipariş toplamlarını mı aktarmak istiyorsunuz?

 

[Levent Menteşoğlu]

Cevap vermekte biraz gecikmişim, uğraşım boşa gitmesin bende tasarladığım kodu vereyim. Aşağıdaki kodu sayfa1'in kod sayfasına kopyalayın.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Offset(0, -1) = "" Or Target = "" Then Exit Sub
Cancel = True
say = WorksheetFunction.CountIf([c:t], Target)
[c:t].Find(What:=Target, After:=ActiveCell, LookAt:=xlWhole).Activate
ActiveCell.Interior.ColorIndex = 34
For a = 1 To say
[c:t].FindNext(After:=ActiveCell).Activate
ActiveCell.Interior.ColorIndex = 34
deg = deg + ActiveCell.Next
Next
[w65536].End(3).Offset(1, 0) = Target
[x65536].End(3).Offset(1, 0) = deg
End Sub

 

[irfancantr]

Size sonsuz saygılarımı sunuyorum beni okadar mutlu ettiniz ki anlatamam umarım sıkıntı vermemişimdir.Çok çok teşekkürler,başka birşey söyleyemiyorum