عطف گذاري فيلدهاي مشابه دو شيت به كمك حلقه for

[pmoshir]

ممنون از پاسختون ميشه كدتون به انتخاب يك محدوده تغيير پيدا كنه؟؟؟؟
من فايل رو پيوست كردم ميشه تغييرات رو اين فايل اعمال كنيد ميخوام وقتي اسناد مشابه در دفاتر طرفين پيدا شد عطف گذاري بشه

[M_ExceL]

با سلام خدمت دوستان
ميخوام با استفاده از حلقه كدي بنويسم كه بعد از پيدا كردن فيلد مشابه دو شيت مجزا(مثلا شماره سند) در ستون جديد عطف گذاري بشه
با تشكر

سلام،
کد زیر فیلد های شیت 1 و 2 رو بررسی میکنه و در صورت وجود فیلد مشابه داخل ستون جدید هر دو شیت عطف قرار میده.

Sub atf()
Dim col(1 To 2) As Byte
col(1) = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
col(2) = Sheets(2).Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To col(1)
For j = 1 To col(2)
If Sheets(1).Cells(1, i) = Sheets(2).Cells(1, j) Then
Sheets(1).Cells(1, col(1) + 1) = chrw(1593) & chrw(1591) & chrw(1601)
Sheets(2).Cells(1, col(2) + 1) = chrw(1593) & chrw(1591) & chrw(1601)
End If
Next j
Next i
End Sub

کد زیر ستون های اول شیت 1 و 2 رو بررسی میکنه و در صورت وجود مقدار مشابه داخل ستون جدید هر دو شیت عطف قرار میده.

Sub atf()
Dim row(1 To 2) As Double
row(1) = Sheets(1).Range("a" & Rows.Count).End(xlUp).row
row(2) = Sheets(2).Range("a" & Rows.Count).End(xlUp).row
For i = 1 To row(1)
For j = 1 To row(2)
If Sheets(1).Range("a" & i) = Sheets(2).Range("a" & j) Then
Sheets(1).Range("b" & i) = ChrW(1593) & ChrW(1591) & ChrW(1601)
Sheets(2).Range("b" & j) = ChrW(1593) & ChrW(1591) & ChrW(1601)
End If
Next j
Next i
End Sub

البته اگر منظورتون رو درست متوجه شده باشم.
یا حق.

[pmoshir]

با سلام خدمت دوستان
ميخوام با استفاده از حلقه كدي بنويسم كه بعد از پيدا كردن فيلد مشابه دو شيت مجزا(مثلا شماره سند) در ستون جديد عطف گذاري بشه
با تشكر