Farklı tablodaki değeri değiştirme

[hadiordan03]

Merhaba Arkadaşlar. Bende dükkanda kullandığım bir dosya var. Şu an 55.000 satıra ulaştım. Stok takibi, satış bilgileri vs yapıyorum. EXCEL 2010. Benim son zamanlarda sıkıntım sattığım bir malı otomatik olarak stok tabelamda düşülmesini sağlayacak olan bir formül (Makro). Örneğin bir satırda tornavida satmışım, Stok tabelasındaki aynı tornavidayı fonksiyon tuşlarından ÖRN: F7 ye basarak anında düşülmesini sağlamak.
Bu konuda bana yardımcı olabilecek arkadaşlar şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Fonksiyon tuşu değil ama Komut düğmesi ekledim kayıt etmek için.

Aşağıdaki kodlar sayfa1 in kod bölümünde olmalı.

Private Sub CommandButton1_Click()
    
    Dim c   As Range, _
        Sh2 As Worksheet, _
        Adr As String
    
    Set Sh2 = Sheets("Sayfa2")
    
    If Not Range("D" & ActiveCell.Row) = "" Then
        MsgBox Range("B" & ActiveCell.Row) & " Adet " & Range("A" & ActiveCell.Row) & " ZATEN İŞLEM GÖRMÜŞ", vbCritical
        Exit Sub
    End If
    
    If Not Application.WorksheetFunction.CountA(Range("A" & ActiveCell.Row & ":C" & ActiveCell.Row)) = 3 Then
        MsgBox Range("A" & ActiveCell.Row) & " MALZEMESİNE AİT TÜM VERİLERİ GİRMEDİNİZ...", vbCritical
        Exit Sub
    End If
    
    Set c = Sh2.Range("A:A").Find(Range("A" & ActiveCell.Row), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Sh2.Cells(c.Row, "B") = Cells(c.Row, "B") - Range("B" & ActiveCell.Row)
        Range("D" & ActiveCell.Row) = Now
        Adr = "A" & c.Row & ":B" & c.Row
        
        ActiveSheet.Shapes.Range(Array("Goruntu")).Select
        Selection.Formula = "=Sayfa2!" & Adr
        
        If Sh2.Cells(c.Row, "B") < 1 Then MsgBox Range("A" & ActiveCell.Row) & " STOĞA DİKKAT ....", vbCritical
    Else
        MsgBox Range("A" & ActiveCell.Row) & " SAYFA2 DE BULUNAMADI ....", vbCritical
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Shapes("CommandButton1").Top = Range("A" & Target.Row).Offset(0, 4).Top
    ActiveSheet.Shapes("CommandButton1").Left = Range("A" & Target.Row).Offset(0, 4).Left
    ActiveSheet.Shapes("Goruntu").Top = Range("A" & Target.Row).Offset(2, 4).Top
    ActiveSheet.Shapes("Goruntu").Left = Range("A" & Target.Row).Offset(2, 4).Left
    
End Sub

 

[Necdet]

Arkadaşımız soruyu sormuş bir daha foruma uğramamış

 

[hadiordan03]

Tekrar forumdayım

Cevabınız için teşekkürler.
Henüz bakamadım.Kusura bakmayın