[حل شده] پيدا كردن رديف هاي متوالي شروع شده با كاراكتر # (هشتك) در ستون a و اضافه نمودن محتويات اين سلول ها به سلول رديف ماقبل

[avicenna]

با سلام. در فايل نمونه پيوست شده، يك ستون A با 10000 رديف وجود داره. من ميخوام هرجا

رديف هاي متوالي شروع شده با كاراكتر # (هشتك) در ستون A

شروع شدن رو پيدا كنم و محتويات اين سلول ها را در سلول قبل از اين رديف ها جمع كنم.مثلا اين:

	P: Numerous hematologic and biochemical abnormalities correlate with the prevalence and severity of retinopathy:
	# increased platelet adhesiveness
	# increased erythrocyte aggregation
	# abnormal levels of serum lipids
	# defective fibrinolysis

تبديل بشود به اين:

	P: Numerous hematologic and biochemical abnormalities correlate with the prevalence and severity of retinopathy: # increased platelet adhesiveness # increased erythrocyte aggregation # abnormal levels of serum lipids # defective fibrinolysis

نمونه فايل رو ببينين: محل اين رديف هاي متوالي از هم فاصله دارن.
با تشكر

[rasools13]

سلام
از فرمول ذیل استفاده کنید

=if(mid(a1,1,1)="#",a1,"") 

[avicenna]

سلام
از فرمول ذیل استفاده کنید

=if(mid(a1,1,1)="#",a1,"") 

سلام. تشکر از راهنمایی تون. من این فرمول رو گذاشتم توی خونه b2 و می خواستم توی کل ستون b اعمالش کنم ولی چنین پیغامی داد:
[ATTACH=CONFIG]17857[/ATTACH]
ممنون از وقتی که برای من گذاشتین.

[rasools13]

احتمالا جدا کننده آرگومان ها در سیستم شما بجای , کاراکتر ; است

[avicenna]

سلام. فرمول پیشنهادی شما رو توی خونه B1 گذاشتم و با کمک Autofill توی ستون B گسترشش دادم. نتیجه به این صورت شد:

هدف من این بود که به این شکل در بیاد:

[rasools13]

فایل پیوست رو بررسی کنید
اطلاعات خودتون رو در ستون a کپی کنید

[iranweld]

با سلام

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

فقط در فایل اصلی خود سلولهایی که مرچ شده اند را به حالت غیر مرچ برگشت دهید

Sub test()

NextRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To NextRow

If InStr(Range("A" & i), "#") > 0 Then

k = 0


For j = i To i + 15

If InStr(Range("A" & j), "#") > 0 Then

k = k + 1

Else

For y = 0 To k

If y = 0 Then

 xx = Range("A" & i - 1 + y)
 
 Else
 
 xx = xx & Chr(10) & Range("A" & i - 1 + y)
 
 End If
 
 Next

Range("b" & i - 1) = xx

xx = ""

Exit For


End If

Next

End If

i = i + k

k = 0

Next


End Sub 

[iranweld]

فایل پیوست شد