البحث في الموقع

السلام عليكم ورحمة الله وبركاته استيراد اسطر معينة من ملف نصي (مفكرة) بدلالة كلمات موجودة في اسطر الملف النصي وهو طلب لاحدهم جعلته هنا لتعم الفائدة 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