استفاده از Find و Replace در VB به صورت شرطی

[sabertb]

سلام خدمت همه اساتید گرامی
با تبریک سال نو خدمت همه عزیزان سوالی در مورد VB داشتم
در فایل پیوست قصد دارم سطر Sample را در مقابل هر نام پروژه کپی کنم و با استفاده از روش Find & Replace اسم پروژه مورد نظرش رو جایگزینه کلمه Sample کند (نکته حتما از روش Find & Replace استفاده شود) با این شرط که به ترتیب از بالا به پایین در مقابل ستون پروژها این کار را بکند و وقتی به سلول خالی یا صفر رسید متوقف شود.

Sub Macro2()
'
' Macro2 Macro
'


'
    Range("D2:M2").Select
    Selection.Copy
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:="SAMPLE", Replacement:="A", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:="SAMPLE", Replacement:="B", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:="SAMPLE", Replacement:="C", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D7").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:="SAMPLE", Replacement:="E", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

[iranweld]

با سلام

کدهای ذیل را تست کنید.

Sub test()

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

k1 = Cells(3, Columns.Count).End(xlToLeft).Column

For i = 4 To z1

For j = 4 To k1

Cells(i, j) = Cells(i, 3) & Cells(3, j)

Next

Next


End Sub 

[sabertb]

با سلام

کدهای ذیل را تست کنید.

Sub test()

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

k1 = Cells(3, Columns.Count).End(xlToLeft).Column

For i = 4 To z1

For j = 4 To k1

Cells(i, j) = Cells(i, 3) & Cells(3, j)

Next

Next


End Sub 

ممنون از راهنماییتون ولی همانطور که در متن سوال نوشتم دقیقا کمک از دستور Find &Replace مورد نظرم هست چون ممکنه بجای سطر Sample یه رشته فرمول باشد که لازم هست داخل فرمول بخشی که مثلا Sample نام دارد در آدرس دهی به اسامی ستون Projectها تغییر یابد

[iranweld]

این کد را تست کنید

کلمه مورد نظر برای Replace را در سلول B1 وارد کنید

Sub Macro2()

    Range("D2:M2").Copy
    
    For i = 4 To 10
    
    
    Range("D" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:=Range("b1"), Replacement:=Range("c" & i), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Next
    
End Sub 

[sabertb]

این کد را تست کنید

کلمه مورد نظر برای Replace را در سلول B1 وارد کنید

Sub Macro2()

    Range("D2:M2").Copy
    
    For i = 4 To 10
    
    
    Range("D" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Replace What:=Range("b1"), Replacement:=Range("c" & i), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        Next
    
End Sub 

سلام خیلی عالی بود فقط یه مورد مونده اونم رنجی که توش کپی میکنه متناسب با ستون اسامی پروژه ها نیست مثلا اگر ستون شامل 15 تا پروژه بود جولوی اون 15 تارو قرار بده و تغییرات بده اگر 2 تا بود همون دوتارو انجام بده