ثبت نشدن مقدار تکراری و دادن هشدار به کاربر

[mfr]

با سلام من ماکرویی به شکل زیر دارم که یک مقداری از اطلاعات(از j3 تا j21 ) رو به جای دیگه (شیت اطلاعات) کپی میکنه حال میخوام در صورت تکراری بودن مثلا d1 هشدار تکراری بودن بده در ضمن مقدار کپی نشه چه تغییری توی ماکرو باید بدم .... ممنونم

Sub Macro3()
Range("j3:j21").Select
Selection.Copy
Sheets("اطلاعات").Select
Range("d1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

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

[Ali Parsaei]

سلام،
منظورتان از:

"در صورت تکراری بودن مثلا d1" چيه؟
متوجه نمي شوم!! چي تکراري باشد؟ يعني رديفي که در زير داده هاي ستون D پيست مي کنيد اولين خانه اش با D1 برابر باشد؟ يا در کل سطر مقداري برابر D1 وجود داشته باشد؟ يا ....؟

[mfr]

این ماکرو اطلاعاتی رو که بصورت ستونی از قبل داریم در یک سطر افقی کپی میکنه حالا میخوام اگه مثلا سلول b1 رو خواست کپی کنه اول چک کنه ببینه تکراری هست یا نه .. اگر بود هشدار تکراری بودن بده و ذخیره نشه ... واگر تکراری نبود ذخیره بشه ... ممنونم

[Alireza]

با سلام من ماکرویی به شکل زیر دارم که یک مقداری از اطلاعات(از j3 تا j21 ) رو به جای دیگه (شیت اطلاعات) کپی میکنه حال میخوام در صورت تکراری بودن مثلا d1 هشدار تکراری بودن بده در ضمن مقدار کپی نشه چه تغییری توی ماکرو باید بدم .... ممنونم

Sub Macro3()
Range("j3:j21").Select
Selection.Copy
Sheets("اطلاعات").Select
Range("d1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

سلام
ماکرویی که دارید و از روش ضبط استفاده کردید خیلی قابلیت نداره شما باید با استفاده حلقه for each اطلاعات شیت اول رو در شیت دوم بررسی کنید و با شرط غیر تکراری بودن وارد شیت دوم کنید

[iranweld]

با سلام

کد زیر را امتحان کنید
نام شیت دوم data

Private Sub CommandButton1_Click()
Z = Sheet2.Cells(Sheet2.Rows.Count, "d").End(xlUp).Row
t = 1
For i = 2 To Z
If Sheet1.Range("j3").Value = Sheet2.Range("d" & i).Value Then
MsgBox "tegrari"
t = t + 1
Exit For

End If
Next i

If t = 1 Then
Sheet1.Select
Sheet1.Range("j3:j21").Copy

Sheets("data").Select
Z = Z + 1
Sheet2.Range("d" & Z).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Sheet2.Range("d" & Z).Select

End If

End Sub 

[mfr]

بسیار بسیار بسیار ................................. ممنونم دوست خوبم