درخواست دریافت کد

[kohan]

با سلام و عرض ادب خدمت اساتید محترم
برای فایل ذیل میخواهم کدی بنویسم که اگر b1 برابر شد با مثلا پروژه1 متناظر ردیف 1 یعنی b4 بشود ماسه و متناظر ردیف 2 بشود آهن و ردیف 3 بشود چوب ولی اگر b2 برابر شد با پروژه 2 متناظر ردیف 1 یعنی b4 بشود چوب
البته خواستم از شرط تودر تو استفاده کنم که جواب میداد اما رشته فرمول بسیار طولانی میشود برای همین اگر مقدور باشد دوستان کدی در وی بی ارائه کنند تا سرمشق باشد

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

[iranweld]

با سلام

لطفا موارد خواسته شده را با توضیح در فایل ضمیمه بیان کنید

[kohan]

با سلام

لطفا موارد خواسته شده را با توضیح در فایل ضمیمه بیان کنید

خب همانطور که در فایل میبیند ما یک شیت داریم که قرار است با انتخاب پروژه ردیفهای آن پر شود و چون این ردیفها در پروژه های مختلف متفاوتند و تعداد پروژه ها زیاد هستند میخواهم غیر از فرمول دهی از طریق کد وی بی انجام بدهم تا بصورت نمونه و کاربردی با نحوه این رویه نیز آشنا بشوم

[iranweld]

با سلام

با استفاده از دستور vlookup و ارجاع به شیت مورد نظر از طریق indirect امکانپذیر است

دقت نمایید که نام شیت در dropdown منو با خود شیت برابر باشد در فایل شما نام شیت "پروژه 1 "(با فاصله بین نام و عدد) ولی در منویی تعبیه شده "پروژه1"بود

=VLOOKUP(A4,INDIRECT("'"&$B$1&"'!"& "A:B"),2,FALSE) 

از طریق VB

Sub TEST()

Dim sheet As Worksheet, I As Integer

 With ThisWorkbook
         
        For I = 1 To .Sheets.Count
        
        Z1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

If Sheets(I).Name = Sheet1.Range("B1").Value Then

Z2 = Sheets(I).Cells(Sheets(I).Rows.Count, "A").End(xlUp).Row

For J = 4 To Z1

For K = 1 To Z2

If Sheet1.Range("A" & J).Value = Sheets(I).Range("A" & K).Value Then

Sheet1.Range("B" & J).Value = Sheets(I).Range("B" & K).Value

End If

Next: Next

End If

Next

End With

End Sub 

[Ali Parsaei]

سلام،
به صورت ساده براي اينکه متوجه شويد کد زير را مي نويسم که فقط جهت سل B4 شيت يک است:

Sheets("Sheet1").Range("B4").Value = Sheets(Range("B1").Value).Range("B1").Value 

بعد بايد براي انتقال هر سطر با الگوي فوق بايد يک خط فرمول بنويسيد، البته اصولي اش نوشتن يک حلقه است، فقط چون گفته ايد: "مي خواهم با رويه اش آشنا شوم" گفتم شايد با حلقه بنويسم گيج شويد، باز اگر خواستيد بگوييد تا با روش تعريف حلقه هم کد آن را برايتان بنويسم.
يک نکته مهم هم اين است که نام شيتهاي شما بايد با نامي که در سل B1 شيت يک انتخاب مي کنيد دقيقا" يکي باشد (که الآن نيست) مثلا" يکي: "پروژه1" و ديگري: "پروژه 1" است يعني يک فاصله بين پروژه و عدد هست.

[kohan]

باتشکر فراوان از اساتید
در پاسخ ارائه شده iranweld عزیز امکانش هست دکمه ماکرو حذف شود و کد خودکار اجرا شود همینطور
آیا میتوان شیتها را حذف کرد و در کد وی بی شرطها را قرارداد

[iranweld]

منظور شما با انتخاب نام شیت بصورت خودکار آیتمها پر شوند؟
سوال دوم را بیشتر توضیح دهید

[kohan]

منظور شما با انتخاب نام شیت بصورت خودکار آیتمها پر شوند؟
سوال دوم را بیشتر توضیح دهید

در مورد اولی بله و در مورد دومی مثلا میخواهم در کد پروژه1 را معرفی کنم که ردیف 1 در سل مقابل محصول ماسه را قرار بدهد و همنطور تا آخر

[iranweld]

در مورد اولی بله و در مورد دومی مثلا میخواهم در کد پروژه1 را معرفی کنم که ردیف 1 در سل مقابل محصول ماسه را قرار بدهد و همنطور تا آخر

فایل مورد اول در پست قبلی ضمیمه شد

برای مورد آخری لطفا خواسته خود را در یک فایل نشان داده و ضمیمه پست کنید


بر روی فایل قبلی یک اصلاحیه جهت پاک کردن ستون b شیت اول قبل از اجرای ماکرو برای شیت بعدی اضافه کردید

[kohan]

سلام،
به صورت ساده براي اينکه متوجه شويد کد زير را مي نويسم که فقط جهت سل B4 شيت يک است:

Sheets("Sheet1").Range("B4").Value = Sheets(Range("B1").Value).Range("B1").Value 

بعد بايد براي انتقال هر سطر با الگوي فوق بايد يک خط فرمول بنويسيد، البته اصولي اش نوشتن يک حلقه است، فقط چون گفته ايد: "مي خواهم با رويه اش آشنا شوم" گفتم شايد با حلقه بنويسم گيج شويد، باز اگر خواستيد بگوييد تا با روش تعريف حلقه هم کد آن را برايتان بنويسم.
يک نکته مهم هم اين است که نام شيتهاي شما بايد با نامي که در سل B1 شيت يک انتخاب مي کنيد دقيقا" يکي باشد (که الآن نيست) مثلا" يکي: "پروژه1" و ديگري: "پروژه 1" است يعني يک فاصله بين پروژه و عدد هست.

با تشکر از جنابعالی اگر مقدور هست همین خط را توضیح بدهید