hanafymahmood قام بنشر ديسمبر 23, 2018 مشاركة قام بنشر ديسمبر 23, 2018 المرفق شيت به عمود واحد الصف الاول الاسم والثانى الرقم وهكذا ..... والمطلوب فصل الاسم عن الرقم بحيث يكون كل بيان فى عمود منفصل علما بأن عددالصفوف يتعدى الألف 1.rar رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 23, 2018 مشاركة قام بنشر ديسمبر 23, 2018 جرب المرفق لعل فيه ما تريد... 1.xlsx 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر ديسمبر 23, 2018 مشاركة قام بنشر ديسمبر 23, 2018 بارك الله فيك استاذى الكريم عمل رائع رابط هذا التعليق شارك More sharing options...
hanafymahmood قام بنشر ديسمبر 23, 2018 الكاتب مشاركة قام بنشر ديسمبر 23, 2018 جزاكم الله خيرا سيدى فعلا هو ما أريده رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 23, 2018 مشاركة قام بنشر ديسمبر 23, 2018 بهد اذن اخي بن علية هذا الملف الكود Option Explicit Sub divise_col_In_Tow() Dim list1 As Object Dim list2 As Object Dim arr1, arr2 Set list1 = CreateObject("System.Collections.ArrayList") Set list2 = CreateObject("System.Collections.ArrayList") Dim My_sh As Worksheet: Set My_sh = Sheets("salim") Dim lr%: lr = My_sh.Cells(Rows.Count, 1).End(3).Row Dim i% My_sh.Range("b2").Resize(1000, 2).ClearContents For i = 1 To lr Step 2 list1.Add Range("a" & i).Value list2.Add Range("a" & i + 1).Value Next i arr1 = list1.toarray: arr2 = list2.toarray My_sh.Range("b2").Resize(UBound(arr1) + 1) = _ Application.Transpose(arr1) My_sh.Range("c2").Resize(UBound(arr2) + 1) = _ Application.Transpose(arr2) list1.Clear: list2.Clear Erase arr1: Erase arr2 Set list1 = Nothing: Set list2 = Nothing End Sub الملف مرفق Salim_tow From one.xlsm 1 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.