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

[adelparsa]

سلام دوستان
من یه فایل اکسل دارم که 22 شیت داره و توی هر شیت توی ستون a اون یک تا 4 شماره موبایل نوشته شده , من میخوام شماره موبایل ها جدا بشه و هر شماره موبایل توی یه سلول جدا قرار بگیره ( ترجیحا همش بیاد توی یه ستون ) و اول اون شماره هایی که صفر نداره هم صفر اضافه بشه .
ممنون اگه کمک کنید.

[adelparsa]

یعنی میخوام توی هر شیت یه ستون شماره موبایل با صفر باشه که توی هرسلول اون ستون یه شماره باشه

[امين اسماعيلي]

با درود
من چند شیت رو به راحتی انجام دادم. ستون A رو انتخاب کنید و از تب data گزینه text to column رو انتخاب کنید و سپش next و سپس space رو تیکش رو بزنین و next و سپس finish با این کار شماره ها تون تو ستون های مختلف جدا میشن. عرض ستون ها رو درست کنید اگر اعداد به صورت نماد علمی در اومدن. بعدش کل ستون هاتونو انتخاب و راست کلیک کرده و فرمت سل رو انتخاب و در بخش custom ان 11 تا صفر بزارین که با این کار صفر در صورت نبودن به ابتدای شماره های شما اظافه میشه

[adelparsa]

سلام دوست عزیز
ممنون از راهنمایی شما.
اگه امکان داره یه راهنمایی دیگه بفرمائید , حالا که شماره ها توی هر سطر مثلا 3 شماره داریم و توی سطر دیگه دو شماره و بعضی ها یکی . اگه بخوایم تمام شماره ها رو توی یه ستون از بالا به پائین بچینیم چطور میتونم انجام بدم.

[amir_ts]

با سلام
به دلیل اینکه سلول خالی در بین اعداد دارید راه حل فرمولی سخت و پیچیده میشه با عرض پوزش از عدم همخوانی جواب با محل پرسش ، این کدها رو امتحان کنید.
فراموش نشه ابتدا از باید از روشی که دوستمون توضیح دادن ستون ها رو جداسازی و بعد کد های زیر رو اجرا کنید.



Sub test()
Dim r, i, j, p As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
'˜í ˜ÑÏä ÓÊæä åÇí Ïæã ÊÇ äÌã
For i = 2 To 5
r = Cells(Rows.Count, i).End(xlUp).Row
Range(Cells(1, i), Cells(r, i)).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Next i
'ÍÐÝ Óáæá åÇí ÎÇáí Èíä ÇÚÏÇÏ ÓÊæä åÇ
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
On Error GoTo 0
'ÇÖÇÝå ˜ÑÏä ÕÝÑ Èå ÇÈÊÏÇí ÇÚÏÇÏ
p = Cells(Rows.Count, "a").End(xlUp).Row
For j = 2 To p
Cells(j, 1).NumberFormat = "@"
Cells(j, 1).Value = "0" & Cells(j, 1).Value
Next j


Next ws
End Sub