[حل شده] اعمال فرمول یک سلول برای سلول های پایین تر

[jack007]

با سلام واحترام
لطفا در فایل پیوست راهنمایی فرمایید چگونه باید فرمول یک سلول را برای چند سلول پاینتر هم اجرا کنم؟ لطفا فایل را ببینید..........با سپاس

[iranweld]

ساختار جدول خود را تغییر داده و از قابلیت پیوت تیبل برای گزارشگیری استفاده نمایید

[jack007]

ضمن سپاس فراوان ........پاسخ شما کاملا صحیح و اصولی است اما اگر اجازه تغییر جداول را نداشته باشم راه حل دیگری دارد ؟

[amir_ts]

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

=CONCATENATE("شهرستان"& "  " &ROW(A1)) 

برای فراخوانی اطلاعات هم از تابع ساده vlookup استفاده کنید....

=IFERROR(VLOOKUP($B3;Sheet1!$B$1:$E$78;2;FALSE);"") 

[rjfri]

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

[iranweld]

اگر ساختار و ترتیب دیتای شما تا آخر بدین صورت باشد، ماکرویی نوشته شد که در صورت موجود بودن کلمه شهرستان در ستون b دیتاهای مقابل آنرا در شیت دوم لیست مینماید

Sub test()

k = 3

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

For Each cell In Sheet1.Range("b2:b" & z1)

If InStr(cell, "شهرستان") > 0 Then

Sheet2.Range("b" & k) = cell

Sheet2.Range("c" & k) = cell.Offset(, 1)

Sheet2.Range("d" & k) = cell.Offset(, 2)

Sheet2.Range("e" & k) = cell.Offset(, 3)

k = k + 1

End If

Next


End Sub 

[iranweld]

با کمکی تغییرات جهت پاک شدن دیتای شیت دوم قبل از ورود دیتای جدید

Private Sub Worksheet_Activate()

k = 3

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

z2 = Sheet2.Cells(Sheet1.Rows.Count, "b").End(xlUp).Row

If z2 < 3 Then z2 = 3

Range("b3:e" & z2).ClearContents


For Each cell In Sheet1.Range("b2:b" & z1)

If InStr(cell, "ÔåÑÓÊÇä") > 0 Then

Sheet2.Range("b" & k) = cell

Sheet2.Range("c" & k) = cell.Offset(, 1)

Sheet2.Range("d" & k) = cell.Offset(, 2)

Sheet2.Range("e" & k) = cell.Offset(, 3)

k = k + 1

End If

Next

End Sub 

[rjfri]

با عذرخواهی از اساتید
فکر کنم منظور دوستمون از شهرستان 1 و شهرستان 2 و .... خواسته مثالی بزنه ، اگر بجای شهرستان 1 بعنوان مثال مشهد و بجای شهرستان 2 شیراز درج بشه چی

[jack007]

ضمن تشکر از همه دوستان و اساتید......
منظور از شهرستان های 1 و 2 و... مثال بوده (همانطور که دوستمون rjfri فرمودند) قطعا بجای انها اسم شهرستان میاد.............
کد استاد iranweld خیلی خوب بود دارم روش کار می کنم باز هم تشکر از دوستان که وقت گذاشتن

[jack007]

سلام مجدد
از بزرگواران (اآقای iranweld)اشاره کردند(( ا

گر جداول شما با نظم خاصی قرار داشتند میشد و بین ردیف ها یک عدد ثابت پیدا کرد راحت میشد به نتیجه دلخواه شما رسید)

) فواصل جداول را اصلاح کردم حال دوستان فقط راهنمایی بفرمایند اگر بخواهیم یک سلول در شیت 2 ......مثلا سلول b10 برابر باشد با سلول b9+1500 تا سلول پایین تر در شیت 1
از چه توابع ترکیبی باید استفاده کرد؟..........................لطفا فایل پیوست که مثال ساده است را ببینید........................با سپاس فراوان

[amir_ts]

با سلام
این فرمول را در سلول b5 شیت دوم قرار بدید و به پایین درگ کنید....

=OFFSET(Sheet1!$A$3;(ROW(A1)-1)*5;) 

[iranweld]

ضمن تشکر از همه دوستان و اساتید......
منظور از شهرستان های 1 و 2 و... مثال بوده (همانطور که دوستمون rjfri فرمودند) قطعا بجای انها اسم شهرستان میاد.............
کد استاد iranweld خیلی خوب بود دارم روش کار می کنم باز هم تشکر از دوستان که وقت گذاشتن

این فایل را هم تست کنید در صورتیکه درهر سلول ستون A ، به حرف "ج" برخورد نماید اطلاعات آن سطر را در شیت دو فراخوانی مینماید

Private Sub Worksheet_Activate()

k = 3

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

z2 = Sheet2.Cells(Sheet1.Rows.Count, "b").End(xlUp).Row

If z2 < 3 Then z2 = 3

Range("b3:e" & z2).ClearContents


For Each cell In Sheet1.Range("A2:A" & z1)

If Len(cell) = 1 And InStr(cell, "ج") > 0 Then

Sheet2.Range("b" & k) = cell.Offset(, 1)

Sheet2.Range("c" & k) = cell.Offset(, 2)

Sheet2.Range("d" & k) = cell.Offset(, 3)

Sheet2.Range("e" & k) = cell.Offset(, 4)

k = k + 1

End If

Next

End Sub 

[jack007]

هر دو روش فوق کاملا درست جواب داد ........بسیار بسیار سپاس گذار................