استيراد اسطر معينة من ملف نصي (مفكرة)

**عبدالله باقشير** · أكتوبر 30, 2012

السلام عليكم ورحمة الله وبركاته

استيراد اسطر معينة من ملف نصي (مفكرة)

بدلالة كلمات موجودة في اسطر الملف النصي

وهو طلب لاحدهم جعلته هنا لتعم الفائدة

http://www.officena....showtopic=43791

الكود :

Option Explicit
'''''''''''''''

' اسم ملف النص
Const tName As String = "QQQ.txt"
'''''''''''''''''''''''''''''''
' كلمة البحث عن سطر الكود كما هي في ملف النص
Const S1 As String = "كود:"
'''''''''''''''''''''''''''''''
' كلمة البحث عن سطر الاجمالي كما هي في ملف النص
Const S2 As String = "الأجــمــالي"
'''''''''''''''''''''''''''''''

Sub kh_Import_Lines_of_TextFile()
Dim MySplit
Dim MyFile As String, MyText As String
Dim iRow As Long
'=============================
' مسح محتويات الجدول
Range("A3:F14").ClearContents
'''''''''''''''''''''''''''''''
' tName الاسم الكامل لملف النص الموجود في مسار ملف الاكسل والذي تم تعيين اسمه في الثابت
MyFile = ThisWorkbook.Path & ThisWorkbook.Application.PathSeparator & tName
'''''''''''''''''''''''''''''''
' اول صف لنقل البيانات
iRow = 3
'=============================
Application.ScreenUpdating = False
'=============================
Open MyFile For Input Access Read As #1
'=============================
While Not EOF(1)
Line Input #1, MyText
'''''''''''''''
' S1 اذا كان يحتوي السطر على الكلمة المعينة في الثابت
If InStr(MyText, S1) Then
' معالجة السطر لاعطائنا الرقم فقط
MyText = Mid$(MyText, InStr(MyText, S1))
MyText = Replace(MyText, S1, "")
MyText = WorksheetFunction.Trim(MyText)
Range("A" & iRow).Value = MyText
End If
'''''''''''''''''''''''
' S2 اذا كان يحتوي السطر على الكلمة المعينة في الثابت
If InStr(MyText, S2) Then
' معالجة السطر وتحويله الى اعمدة بالنص الرقمي المطلوب
MyText = Replace(MyText, S2, "")
MyText = WorksheetFunction.Trim(MyText)
MySplit = Split(MyText)
With Range("B" & iRow).Resize(1, UBound(MySplit) + 1)
.Value = MySplit
' تحويل النص الرقمي في الخلية الى رقم
.Replace ",", "."
End With
iRow = iRow + 1
End If
'''''''''''''''''''''''
Wend
Close #1
'=============================
Application.ScreenUpdating = True
'=============================

End Sub

المرفق ملف اكسل 2003-2007
ملف نصي + صورة
استيراد اسطر معينة من ملف نصي.rar

===========================================
المرفق الثاني
امثلة لاستيراد وتصدير
لجدول بيانات مرتب

Dim MyCode As Double, MyCur As String, MyDate As Date


Sub ExportRange()
Dim r As Integer
    
Open ThisWorkbook.Path & "\textfile.txt" For Output As #1
'''''''''''''''''''''
Do
    r = r + 1
    With Range("B6")
        If Len(Trim(.Cells(r, 1))) = 0 Then Exit Do
        MyCode = .Cells(r, 1)
        MyCur = .Cells(r, 2)
        MyDate = .Cells(r, 3)
    End With
    '''''''''''''''''''''
    Write #1, MyCode, MyCur, MyDate
    '''''''''''''''''''''
Loop
'''''''''''''''''''''
Close #1
'''''''''''''''''''''
End Sub
Sub ImportRange()
Dim i As Integer

Range("B6").Resize(1000, 3).ClearContents
On Error GoTo 1
Open ThisWorkbook.Path & "\textfile.txt" For Input As #1
    
While Not EOF(1)
    Input #1, MyCode, MyCur, MyDate
    i = i + 1
    '''''''''''''''''''''
    With Range("B6")
        .Cells(i, 1) = MyCode
        .Cells(i, 2) = MyCur
        .Cells(i, 3) = MyDate
    End With
    ''''''''''''''''''''
Wend
Close #1
1:
End Sub

المرفق ملف اكسل 2003-2007
استيراد تصدير.rar

سمير هنداوي · أكتوبر 30, 2012

بارك الله فيك أخونا العزيز عبد الله باقشير

سمير هنداوي · أكتوبر 30, 2012

فعلا رأيت الملف أنت أستاذ و رئيس قسم بارك الله فيك أخي العزيز

تقبل تحيتي و سلامي

**اوفيس 2003** · أكتوبر 30, 2012

ياسلالالالام عليك يا استاذنا ، والله هذا مااريد بالفعل ،ولكن محتاج وقت كبير لأتعلمه يا استاذنا دعواتك لي ، لي سؤال على السريع ياغالي فرضا ان الملف النصي المرفق ده اكبر في الحجــم واكثر في البيانات هل ممكن ان اصممه ليظهر هذه النتائج ياغالي

وياريت لو ترفقلي الكود بدون الشرح ايضا ياغالي

ويعد اذنك اريد ان ارسلك شيء خاص جدا في عملي على الخاص فبرجاء اسمحلي بالإرسال لأنه يرفض تماماً

تم تعديل أكتوبر 30, 2012 بواسطه office 2003

**عبدالله باقشير** · أكتوبر 31, 2012

فعلا رأيت الملف أنت أستاذ و رئيس قسم بارك الله فيك أخي العزيز

تقبل تحيتي و سلامي

جزاك الله خيرا

**عبدالله باقشير** · أكتوبر 31, 2012

ياسلالالالام عليك يا استاذنا ، والله هذا مااريد بالفعل ،ولكن محتاج وقت كبير لأتعلمه يا استاذنا دعواتك لي ، لي سؤال على السريع ياغالي فرضا ان الملف النصي المرفق ده اكبر في الحجــم واكثر في البيانات هل ممكن ان اصممه ليظهر هذه النتائج ياغالي

وياريت لو ترفقلي الكود بدون الشرح ايضا ياغالي

ويعد اذنك اريد ان ارسلك شيء خاص جدا في عملي على الخاص فبرجاء اسمحلي بالإرسال لأنه يرفض تماماً

فرضا ان الملف النصي المرفق ده اكبر في الحجــم واكثر في البيانات هل ممكن ان اصممه ليظهر هذه النتائج ياغالي

جرب الكود بنفسك

على اي ملف نصي فيه بيانات اكثر بنفس معايير الملف النصي الحالي

وابعد صف المجاميع في الورقة

واخبرنا بالنتائج

للمراسلة اضغط الصورة اللي فيها اسمي

في توقيعي

**أبو حنــــين** · أكتوبر 31, 2012

بارك الله فيكم أخي الحبيب : عبد الله

جزاكم الله خيرا

عمل متقن فعلا

**أنس دروبي** · أكتوبر 31, 2012

السلام عليكم ورحمة الله وبركاته

الله يجزيك الخير أستاذي عبد الله باقشير

والله أنه عمل متقن ومبدع من استاذ محترف

ولكن أستاذي لو أفترضنا أننا نريد العكس وهي التصدير من ملف إكسل الى ملف نصي أو صفحة ويب ولكن في تنسيق معين

فهل يصح ذلك وفي نفس الوقت الاستيراد من هذا الملف النصي

مثل نسخة أحتياطية قابلة للاستراجع

والسلام عليكم ورحمة الله وبركاته

تقبل مروري وتحياتي

أخوكم أنس دروبي

**عبدالله باقشير** · نوفمبر 2, 2012

بارك الله فيكم أخي الحبيب : عبد الله

جزاكم الله خيرا

عمل متقن فعلا

جزاك الله خيرا

اخي الحبيب ابوحنين

تقبل تحياتي وشكري

**عبدالله باقشير** · نوفمبر 2, 2012

السلام عليكم ورحمة الله وبركاته

الله يجزيك الخير أستاذي عبد الله باقشير

والله أنه عمل متقن ومبدع من استاذ محترف

ولكن أستاذي لو أفترضنا أننا نريد العكس وهي التصدير من ملف إكسل الى ملف نصي أو صفحة ويب ولكن في تنسيق معين

فهل يصح ذلك وفي نفس الوقت الاستيراد من هذا الملف النصي

مثل نسخة أحتياطية قابلة للاستراجع

والسلام عليكم ورحمة الله وبركاته

تقبل مروري وتحياتي

أخوكم أنس دروبي

جزاك الله خيرا

بالنسبة لاستفسارك

راجع الاكود التالية

كود للاستيراد وكود للتصدير


Dim MyCode As Double, MyCur As String, MyDate As Date



Sub ExportRange()

Dim r As Integer


Open ThisWorkbook.Path & "\textfile.txt" For Output As #1

'''''''''''''''''''''

Do

r = r + 1

With Range("B6")

If Len(Trim(.Cells(r, 1))) = 0 Then Exit Do

MyCode = .Cells(r, 1)

MyCur = .Cells(r, 2)

MyDate = .Cells(r, 3)

End With

'''''''''''''''''''''

Write #1, MyCode, MyCur, MyDate

'''''''''''''''''''''

Loop

'''''''''''''''''''''

Close #1

'''''''''''''''''''''

End Sub

Sub ImportRange()

Dim i As Integer


Range("B6").Resize(1000, 3).ClearContents

On Error GoTo 1

Open ThisWorkbook.Path & "\textfile.txt" For Input As #1


While Not EOF(1)

Input #1, MyCode, MyCur, MyDate

i = i + 1

'''''''''''''''''''''

With Range("B6")

.Cells(i, 1) = MyCode

.Cells(i, 2) = MyCur

.Cells(i, 3) = MyDate

End With

''''''''''''''''''''

Wend

Close #1

1:

End Sub

المرفق 2003-2007

استيراد تصدير.rar

تقبل تحياتي وشكري

**قصي** · ديسمبر 8, 2012

العلامة الكبير عبد الله بارك الله فيكم وبكم وسدد الله خطاكم وعافاكم من كل سوء

**abouelhassan** · ديسمبر 8, 2012

والله كل الاحترام روائع استاذنا

بارك الله فيك

تسجيل الدخول

استيراد اسطر معينة من ملف نصي (مفكرة)

الردود الموصى بها

عبدالله باقشير

سمير هنداوي

سمير هنداوي

اوفيس 2003

عبدالله باقشير

عبدالله باقشير

أبو حنــــين

أنس دروبي

عبدالله باقشير

عبدالله باقشير

قصي

abouelhassan

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

انشئ حساب جديد

تسجيل دخول

محتوي مشابه

كيفية تصدير بيانات من عدة قواعد بيانات مختلفة وإستيرادها كلها في قاعدة واحدة

رسالة توضح نوع الخطأ عند الاستيراد من اكسيل

استيراد بيانات من النت 1 2

كيفية استيراد مجموعة ورقات عمل من ملف اكسيل دفعة واحدة

منع التكرار عند الاستيراد

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information