ثبت سوابق

[SIGNAL]

با سلام خدمت دوستان عزیز

این یک فایل اموال سازمانی با بیست کالا می باشد که هر کالا سریال مخصوص به خود دارد.

همه کالاها به افراد مختلف باید تحویل داده شوند و تاریخ تحویل نیز درج شود و بعد از مدت زمانی ممکن است کالا برگشت داده شود و این کالا به نفر دیگری دوباره تحویل داده شود که این رفت و برگشت برای یک کالا ممکن است چندین بار تکرار شود.

نیاز دارم که سوابق بالای 5 روز طبق جدول شیت سوابق نیز نگهداری شود.

زحمت این کار را آقای iranweld کشیده و فایل زیر تهیه گردید، حالا نیاز دارم که تعداد کالاها به 600 کالا افزایش یابد و همچنین سریال کالاها قابل تغییر باشند.

لطفأ در صورت امکان راهنمای فرمایید.

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

با تغییراتی در فایل قبلی فایل جدید تهیه گردید

Option Explicit

Public y, z, z1, z2 As String

Public i, j, x, k, T, C As Integer

Sub test()
z1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

For i = 2 To z1

If Sheet1.Range("c" & i).Value <> "" And Sheet1.Range("d" & i).Value <> "" Then

Sheet1.Range("h1").Value = Sheet1.Range("c" & i).Value
Sheet1.Range("i1").Value = Sheet1.Range("d" & i).Value
z = Sheet1.Range("j1").Value

If z >= 5 Then
x = Sheet1.Range("a" & i).Value
T = i

test1

End If

End If

Next

End Sub


Sub test1()

For j = 2 To z2


If x = Sheet2.Range("A" & j).Value Then

k = Application.WorksheetFunction.CountA(Sheet2.Rows(j & ":" & j)) + 1

Sheet2.Cells(j, k).Value = Sheet1.Range("B" & i).Value
Sheet2.Cells(j, k + 1).Value = Sheet1.Range("C" & i).Value
Sheet2.Cells(j, k + 2).Value = Sheet1.Range("D" & i).Value
Sheet1.Range("B" & i).Value = ""
Sheet1.Range("C" & i).Value = ""
Sheet1.Range("D" & i).Value = ""


End If


Next

End Sub