figo82eg قام بنشر الثلاثاء at 20:37 مشاركة قام بنشر الثلاثاء at 20:37 ارجو من الاخوة الكرام المساعدة حيث لدى ملف اكسل به مديونية الاف العملاء وارصدتهم لدى بالموجب والسالب ومصفره . ما اريد ان اقوم بتقسيم هذا العمود الى ثلاثة اعمدة عمود دائن ويتم توزيع القيم السالبة به وعمود مدين ويتم توزيع القيم الموجبة به وعمود ثالث منتهى به الارصدة المساوية لصفر. فهل استطيع فعل ذلك مرة واحدة رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالله بشير عبدالله قام بنشر الأربعاء at 04:52 أفضل إجابة مشاركة قام بنشر الأربعاء at 04:52 (معدل) قمت بعمل مثال لك بفصل الحالات الثلاتة كما طلبت الكود Sub FilterValues() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ws.Range("G2:H" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row).ClearContents ws.Range("I2:J" & ws.Cells(ws.Rows.Count, "I").End(xlUp).Row).ClearContents ws.Range("K2:L" & ws.Cells(ws.Rows.Count, "K").End(xlUp).Row).ClearContents Dim negArr() As Variant Dim posArr() As Variant Dim zeroArr() As Variant Dim i As Long, negCount As Long, posCount As Long, zeroCount As Long Dim dataRange As Range Set dataRange = ws.Range("B2:C" & lastRow) Dim dataArr As Variant dataArr = dataRange.Value ReDim negArr(1 To UBound(dataArr, 1), 1 To 2) ReDim posArr(1 To UBound(dataArr, 1), 1 To 2) ReDim zeroArr(1 To UBound(dataArr, 1), 1 To 2) negCount = 0 posCount = 0 zeroCount = 0 For i = 1 To UBound(dataArr, 1) Select Case dataArr(i, 2) Case Is < 0 negCount = negCount + 1 negArr(negCount, 1) = dataArr(i, 1) negArr(negCount, 2) = dataArr(i, 2) Case Is > 0 posCount = posCount + 1 posArr(posCount, 1) = dataArr(i, 1) posArr(posCount, 2) = dataArr(i, 2) Case Else zeroCount = zeroCount + 1 zeroArr(zeroCount, 1) = dataArr(i, 1) zeroArr(zeroCount, 2) = dataArr(i, 2) End Select Next i ws.Range("G2").Resize(negCount, 2).Value = Application.Index(negArr, Evaluate("ROW(1:" & negCount & ")"), Array(1, 2)) ws.Range("I2").Resize(posCount, 2).Value = Application.Index(posArr, Evaluate("ROW(1:" & posCount & ")"), Array(1, 2)) ws.Range("K2").Resize(zeroCount, 2).Value = Application.Index(zeroArr, Evaluate("ROW(1:" & zeroCount & ")"), Array(1, 2)) End Sub الملف فصل الدائن والمدين والصفرية الى اعمدة جديدة.xlsb تم تعديل الأربعاء at 13:45 بواسطه عبدالله بشير عبدالله 1 1 رابط هذا التعليق شارك More sharing options...
figo82eg قام بنشر بالامس في 20:41 الكاتب مشاركة قام بنشر بالامس في 20:41 بارك الله فيك اخى الكريم وجعل علمك فى ميزان حسناتك 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان