اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

عمل تأكيد لنقل معلومات من ورقة لأخرى


Jasmin
إذهب إلى أفضل إجابة Solved by lionheart,

الردود الموصى بها

مرحبا إخوتي
عندي كلفي به ورقتين
ورقة 1- Oldstock2021-2022
وبها معلومات المستودع

ورقة 2- Transaction
عنها المعلومات التي أخذناها من الورقة الأولى 
وعندنا عمليتين : بيع وإسترجاع والكمية Quantity
بعد ان أضع الكمية المباعة أريد عمل تأكيد لكي أنقل
الNewStock من هذه الورقة للورقة الأولى Quantity
in stock

2- كيف أضيف الdate تلقائيا كلما أضفت سطر جديد
أنا وضعته  now()  بس كيف يتم كتابته تلقائياً

وشكرا لكم.

test-0-.xlsx

رابط هذا التعليق
شارك

  • أفضل إجابة

Sheet1 should be unprotected to let the code modify the quantity

  In the following code replace this word ÈíÚ with the Arabic equivalent

This is worksheet module (Transaction worksheet)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then
        Application.EnableEvents = False
            x = Application.Match(Target.Offset(, -5).Value, Sheets(1).Columns(3), 0)
            If Not IsError(x) And Target.Offset(, -1).Value = "ÈíÚ" Then
                If MsgBox("New Stock Will Be Updated And This Row Will Be Delete. If OK Click 'Yes'", vbYesNo + vbQuestion) = vbYes Then
                    Sheets(1).Cells(x, 5).Value = Sheets(1).Cells(x, 5).Value - Target.Value
                    Target.EntireRow.Delete
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

شكرا لكم .هذا هو الملف مفتوحا لو تكرمتم،ولكن أنا لا أريد لأحد أن يعدل عليه يدويا.
 .. وأيضا ممكن فكرة عن السؤال الثاني؟Where should i put this code brother
Thank you in advance

test-0-opened.xlsx

رابط هذا التعليق
شارك

أخي
أنا أريد الـ Newstock بالtransaction تنتقل عال Quantity in Stock بالورقة OldStock2021-2022
انا نقلت الكود كما قلت

بالنسبة للنقطة الثانية

كيف ممكن أن يتمّ إضافة تاريخ اليوم عند إضافة كل سطر جديد 
مثلا ترى انه لا يوجد تاريخ في السطر الثاني

 

 

test-0-opened.xlsx

رابط هذا التعليق
شارك

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then
        Application.EnableEvents = False
            x = Application.Match(Target.Offset(, -5).Value, Sheets(1).Columns(3), 0)
            If Not IsError(x) And Target.Offset(, -1).Value = "sale" Then
                If MsgBox("New Stock Will Be Updated And This Row Will Be Delete. If OK Click 'Yes'", vbYesNo + vbQuestion) = vbYes Then
                    Sheets(1).Cells(x, 5).Value = Sheets(1).Cells(x, 5).Value - Target.Value
                    Target.EntireRow.Delete
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

Change the quantity in column G to trigger the code

رابط هذا التعليق
شارك

Thank you very much brother
2 notes please 

1- I need to update the 1st sheet from the column NEWSTOCK (because the operation might be + or - as you can see the difference between the two lines :

 1st was sale & 2nd was retrieval so the final new stock is the reference) Because you only made the code for sale.

2- the 3rd row didn't update the 1st sheet until i rewrite the quantity again !! so it was registered -4 - though it was 2

Notice the quantity was 191 in one row it became 187! 
coz i write 2 twice coz it didn't update the 1st sheet  1st time though i clicked on yes ..

pls add 2 rows & try it for the 2 types of transaction.

I appreciate your help very much, may God reward you.

 test-0-fr-m.xlsm

رابط هذا التعليق
شارك

Dim tmp

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then
        Application.EnableEvents = False
            x = Application.Match(Target.Offset(, -5).Value, Sheets(1).Columns(3), 0)
            If Not IsError(x) Then
                If MsgBox("New Stock Will Be Updated . If OK Click 'Yes'", vbYesNo + vbQuestion) = vbYes Then
                    Sheets(1).Cells(x, 11).Value = Sheets(1).Cells(x, 5).Value
                    Sheets(1).Cells(x, 5).Value = Target.Offset(, 2).Value
                    Cells(Target.Row, 1).Value = Format(Date & Space(1) & Time, "dd/mm/yyyy hh:mm")
                Else
                    If Not IsEmpty(tmp) Then Target.Value = tmp
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then tmp = Target.Value
End Sub

 

رابط هذا التعليق
شارك

Thank you brother 

the date worked just fine

But i ve tried the first row as attached - when you update the stock in the 1dt sheet, too bad the second one change too - so obviously it's not correct.

test-0-fr-m.xlsm

رابط هذا التعليق
شارك

this is the code I have
I deleted the line & saved the file & retried
Same result
 

Dim tmp

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then
        Application.EnableEvents = False
            x = Application.Match(Target.Offset(, -5).Value, Sheets(1).Columns(3), 0)
            If Not IsError(x) Then
                If MsgBox("New Stock Will Be Updated . If OK Click 'Yes'", vbYesNo + vbQuestion) = vbYes Then
                    
                    Sheets(1).Cells(x, 5).Value = Target.Offset(, 2).Value
                    Cells(Target.Row, 1).Value = Format(Date & Space(1) & Time, "dd/mm/yyyy hh:mm")
                Else
                    If Not IsEmpty(tmp) Then Target.Value = tmp
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 2 And Target.Column = 7 Then tmp = Target.Value
End Sub

 

رابط هذا التعليق
شارك

المطلوب هو كالتالي:
الورقة transaction تحتوي على معلومات البضائع من الورقة old transaction

المطلوب نقل الكمية NewStock من ورقة الTransaction  إلى ورقة الـOld transaction عامود E -Quantity in Stock- عند كل سطر وحركة بيع Sale  أو إرجاع Retrieval جديدة

مرفق الملف الأصلي دون كود .. شكرا سلفا

test-0-fr-a.xlsm

رابط هذا التعليق
شارك

أرفق لكم الطريقة كود وملف لمن أراد أن يستفيد لاحقاً

وشكرا للجميع.

 

Option Explicit

Dim fo As Worksheet
Dim ln&, x!, s&

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    If Target.Row > 2 And Target.Column = 7 Then
        Application.EnableEvents = False
        Set fo = Sheets("OldStock2021-2022")
        If Range("B" & Target.Row) <> "" And Range("F" & Target.Row) 

<> "" Then
            ln = WorksheetFunction.Match(Target.Offset(0, -5), fo.Range

("C:C"), 0)
            x = fo.Cells(ln, 5) 'Stok initial sur la feuille OldStock2021-2022
            Cells(Target.Row, 3) = fo.Range("D" & ln)       'Description
            Cells(Target.Row, 4) = fo.Range("G" & ln)       'Prix
            Cells(Target.Row, 5) = x                        'Stock initial
            s = IIf(Target.Offset(0, -1) = "sell", -1, 1)   'sens du mouvement 

= 1 pour retour,-1 pour vente
            Cells(Target.Row, 9) = Target.Value * s + x     'Stock final
            fo.Range("E" & ln) = Target.Value * s + x       'Nouveau stock 

mis à jour
            Range("A" & Target.Row) = Date                  'ou = Now si on 

veut l'horodate
        Else
            MsgBox "Saisies incomplètes.", 16
            Exit Sub
        End If
    End If
    Application.EnableEvents = True
End Sub


Sub Evenement()
        Application.EnableEvents = True
End Sub

 

QuckSolution-1-.xlsm

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information