انتقال اطلاعات با شرط بوسیله vba

[hosein.mirjalili]

با سلام و عرض ادب
در فایل پیوست , شیت 1 و در Table1 بعنوان دیتابیس ما هست حال می خواهیم با VBA اطلاعات دیتابیس ما با توجه به مقدار سلول H1 (ماه) و H2 (سال) در Table2 قرار بگیرد ضمنا اگر از قبل اطلاعات مربوط به ماه و سال انتخاب شده انتقال یافته بود پیغامی جهت یادآوری و درج مجدد یا عدم درج دوباره اطلاعات صادر گردد ممنون و متشکرم

[hosein.mirjalili]

منتظر نظر دوستان هستیم

[iranweld]

با سلام

با استفاده از دو دستور for ابتدا تک تک کدهای شیت اول را در شیت دوم چک کنید اگر وجود نداشت آن ردیف در شیت دوم ذخیره شود و اگر آن کد وجود داشت به شما پیغام بده

Private Sub CommandButton1_Click()

z1 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row

z2 = Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row + 1
    
    If z2 = 3 Then z2 = 2


  For i = 3 To z1

t = 0

For J = 2 To z2

If Sheet1.Range("d" & i) = Sheet2.Range("d" & J) Then

t = 1


End If

Next

If t = 0 Then

Sheet1.Range("b" & i & ":h" & i).Copy Destination:=Sheet2.Range("b" & z2)

Sheet2.Range("a" & z2) = J - 2

z2 = Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row + 1

Else

ANSWER = MsgBox("˜Ï:" & " " & Sheet1.Range("d" & i) & vbNewLine & " ÞÈáÇ ËÈÊ ÔÏå ÇÓÊ", vbYesNo + vbQuestion)


If ANSWER = vbYes Then


    
    Sheet1.Range("b" & i & ":h" & i).Copy Destination:=Sheet2.Range("b" & J)


z2 = Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row + 1
    
Else

    'do nothing
    
End If

End If

Next

End Sub