[حل شده] استخراج شماره تلفن از اکسل

[reza1881]

با سلام خدمت اساتید گرامی

راستش من قبلاً یکبار این موضوع رو مطرح کردم و اساتید لطف کردند و راهنمایی کردن ، ولی می خواستم دوباره خواهش کنم تا یکبار دیگه موضوع رو بررسی کنند .

من باید هر روز از نیازمندی های همشهری ، یکسری شماره تلفن استخراج کنم . پیدا کردن شماره ها از روی روزنامه و تایپ اون در اکسل واقعاً کار طاقت فرسا و زمانبریه . تا اینکه متوجه شدم متن آگهی ها توی سایت راهنمای همشهری هم وجود داره . بنابراین تصمیم گرفتم تا از روی کپی و پیست شماره ها رو وارد اکسل کنم . اساتید زحمت کشیدن و یه فایل اکسل دادن تا شماره ها استخراج بشن ، ولی متاسفانه اون روش همه ی شماره ها رو برداشت نمی کرد ، فکر کنم به دلایل زیر :
1- بعضی آگهی ها هم متن دارند و هم شماره ثابت و همراه مثلا قالیشویی نمونه 888888888-0912222222
2- بعضی آگهی ها فقط شماره موبایل دارند که ممکنه ایرانسل همراه اول تالیا و رایتل باشه ، که فکر کنم در فرمول ها باید بهش توجه بشه
3- توی یه آگهی که فقط شماره موبایل هستش مثل 09355968414 ، این شماره توی ستون نهایی استخراج نمی اومد ( فکر کنم صفر اول باید در اون ستون نقشی داشته باشه )

جسارتاً یه نمونه فایل اکسل که میخوام ازشظ استخراج کنم رو برای نمونه آپلود کردم . اگر بدونید که درست شدن این مسئله چقدر برام مهمه !! مطمئن باشید از لحاظ معنوی هر روزیکه این شماره ها رو استخراج می کنم دعاتون می کنم .

ممنون

متاسفانه آپلود فایل مشکل داره ، جای دیگه آپلود کردم اینهم آدرسش : http://www.uploadco.ir/uploads/yn66ox262u352gb11ig.xlsx
و یا » http://uplod.ir/kuu9w1ry63dj/Phone.xlsx.htm

[khakzad]

دوست عزیز فایل شما رو قبلا بررسی کردم.
بصورت سرپایی نمیشه ج داد (زمان بر هست) منظورم با روش های معمول و ترکیب ساده فرمول ها
اگر مایل هستید بصورت پروژه در قسمت پروژه درخواست بدید تا بصورت دقیق بررسی بشه و یک نفر کاملا اختصاص داده بشه به این موضوع که انجام بشه.

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

[reza1881]

راستش اون فایلی که زحمتش رو کشیدید خیلی عالیه و درسته . فقط شماره موبایل هایی که هیچ متن و یا شماره دیگه ای از اول ندارند(ستون اول) رو توی 2 ستون آخر نمیاره . یه نمونه رو براتون آپ می کنم . اگه میشه یه نگاهی بهش بندازین .

http://www.uploadco.ir/uploads/o83benrd15ckm0idw16.xlsx

کار را که کرد ؟ آنکه تمام کرد
جناب آقای مهندس خاکزاد ، راضی نشید که ما از این انجمن نامید بریم

[reza1881]

up.

[khakzad]

دوست عزیز
متاسفانه فرصت ندارم
دوستان انشاله انجام میدن!
اگر فرصت کردم چشم

پ.ن: خانم خاکزاد هستم جسارتا

[reza1881]

احترام گذاشتن به خانم های محترم که همینجوری هم بر هر مردی واجبه .

حالا چه برسه که مدیر هم باشند

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

با تقدیم احترام
رضا باقری

[khakzad]

جناب باقری
علت وجودی همه در این سایت همین هست که شما فرمودید. (کار بقیه رو راه میندازیم و ححتی فراتر از این ، اموزش میدیم. برای همین هم هست که فایل اماده اصولا سعی می کنیم نذاریم چون میخوایم ماهیگیری یاد بدیم)!
ی گشتی توی سایت بزنید سوال و ج ها رو می بینید. لازمه بدونید کسی بخاطر حضورش در سایت، مبلغی دریافت نمیکنه. و همه این فعالیت ها دلی هست!
اگر غیر از این بود، شما به ازای جواب سوالتون، اولین چیزی که دریافت میکردید شماره حساب بود! . (پس کم لطفی نفرمایید )

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

این فایل هر سلی که عدد داشته باشه استخراج میکنه

نهایتا اون دوسه تا تبلیغی که ساعت کاری داره رو دستی حذف کنید.

[Amir Ghasemiyan]

با اجازه خانم خاكزاد
من هم يه كد نوشتم. ميتونين از اين هم كمك بگيرين. داده هاتون رو تو ستون A قرار بدين و اين كد رو اجرا كنيد. در ستون هاي بعدي ليستي از شماره تلفن ها رو خواهيد داشت

Sub parseNumd()
    Dim i As Integer, tempVal As Variant, s As Integer
For Each c In Range("A1:A98")
    j = 1
    q = 2
    ReDim tempVal(j)
    strSearch = c.Text
    For i = 1 To Len(strSearch)
        If IsNumeric(Mid(strSearch, i, 1)) Then
            ReDim Preserve tempVal(j)
            tempVal(j - 1) = tempVal(j - 1) + Mid(strSearch, i, 1)
        Else
            If Not IsEmpty(tempVal(j - 1)) And Right(tempVal(j - 1), 1) <> " " Then j = j + 1
        End If
    Next
    For s = 0 To UBound(tempVal)
        If Len(tempVal(s)) > 6 Then
            Cells(c.Row, q) = tempVal(s)
            q = q + 1
        End If
    Next
Next c
End Sub

[reza1881]

خانم پاکزاد و آقای قاسمیان سلام

نمی دونم با چه زبونی از شما تشکر کنم . واقعاً از لطفی که فرمودید و زخمتی که کشیدید بینهایییییت سپاسگزارم . از صمیم قلب امیدوارم که موفق و سرزنده باشید . اگر مطلبی از من درج شد که خدای نکرده گمان بر کم لطفی بود ( که واقعاً و صادقانه باید بگم نبود ) به بزرگواریتون ببخشید .



فقط جناب قاسمیان نمی دونم چرا وقتی محتویات دو تا صفحه رو کپی می کنم ، فقط شماره های یک صفحه استخراج میشن و ظاهراً کد روی صفحه های بعدی اعمال نمیشه .
جسارتاً یک نمونه فایل رو براتون آپلود میکنم تا ملاحظه بفرمایید . کنار شماره هایی که اضافه نشدند رو حاشیه قرمز گذاشتم تا ملاحظه کنید.

ممنون

Agahi

[Amir Ghasemiyan]

خانم پاکزاد و آقای قاسمیان سلام

نمی دونم با چه زبونی از شما تشکر کنم . واقعاً از لطفی که فرمودید و زخمتی که کشیدید بینهایییییت سپاسگزارم . از صمیم قلب امیدوارم که موفق و سرزنده باشید . اگر مطلبی از من درج شد که خدای نکرده گمان بر کم لطفی بود ( که واقعاً و صادقانه باید بگم نبود ) به بزرگواریتون ببخشید .



فقط جناب قاسمیان نمی دونم چرا وقتی محتویات دو تا صفحه رو کپی می کنم ، فقط شماره های یک صفحه استخراج میشن و ظاهراً کد روی صفحه های بعدی اعمال نمیشه .
جسارتاً یک نمونه فایل رو براتون آپلود میکنم تا ملاحظه بفرمایید . کنار شماره هایی که اضافه نشدند رو حاشیه قرمز گذاشتم تا ملاحظه کنید.

ممنون

Agahi

من كه تست كردم الان. همه رو درست وارد كرد.
كدتون رو داخل ماژول بذارين و تست كنين ببينين درست ميشه يا خير

[reza1881]

راستش دوباره تست کردم ولی نشد . من خیلی اکسل نمی دونم ولی اینکار ها رو انجام دادم :
کلید های alt+f11 رو زدم
در زیر مجموعه ماژول ، کدی که زحمت کشیدید رو وارد کردم
save کردم
برای اجرا هم دکمه f5 رو زدم


اگر اشتباه هست بفرمایید

ممنون

[reza1881]

مهندس حل شد
توی کد Range رو از A1 تا A10000 تغییر دادم .
بینهایت سپاسگزارم

[Amir Ghasemiyan]

مهندس حل شد
توی کد Range رو از A1 تا A10000 تغییر دادم .
بینهایت سپاسگزارم

خدا رو شكر
پس لطفا تاپيك رو حل شده كنيد