كود فرز البيانات , تجزئة شروط الفرز

[رعد داود]

Sub Solaf()

Dim LastRow As Long, i As Long, ii As Long

Dim SText As String

Dim SText1 As String

Dim StDate As Date, EndDate As Date

With Sheets("ÇáÓáÝ")

.Range("A7:L10000").ClearContents

SText = .Range("B2")

SText1 = .Range("C2")

StDate = .Range("B3")

EndDate = .Range("B4")

End With

ii = 7

With Sheets("yaomea")

LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow

If CStr(.Cells(i, "J")) = SText Then

If CStr(.Cells(i, "N")) = SText1 Then

Select Case .Cells(i, "d").Value2: Case StDate To EndDate

Sheets("ÇáÓáÝ").Cells(ii, "A").Resize(1, 12).Value = .Cells(i, "A").Resize(1, 12).Value

ii = ii + 1

End Select

End If

End If

Next

End With

End Sub

في هذا الكود للأستاذ الفاضل خبور الخير رعاه الله,,,هناك شروط في المديات اريد ان لايشترط ادخال المعلومات فيها جميعا" ماالعمل للأستثناء من ادخال الشروط كلها مجتمعه بعباره أخرى اريد عدم ربط اكمال الشروط كلها بالفرز

[عبدالله المجرب]

السلام عليكم

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

[رعد داود]

مشكور استاذ عبد الله

أرفق لحضرتكم ملف بالمطلوب

solaf.rar

[عبدالله المجرب]

السلام عليكم

جرب هذا التعديل

Sub Solaf()

Dim LastRow As Long, i As Long, ii As Long

Dim SText As String

Dim SText1 As String

Dim StDate As Date, EndDate As Date

With Sheets("السلف")

	    .Range("A7:L10000").ClearContents

	    SText = .Range("B2")

	    SText1 = .Range("C2")

	    StDate = .Range("B3")

	    EndDate = .Range("B4")

End With

ii = 7

With Sheets("yaomea")

	    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

	    For i = 2 To LastRow

			    If CStr(.Cells(i, "J")) = SText Then

   If SText1 = "" Then GoTo 1

			    If CStr(.Cells(i, "N")) = SText1 Then

1

					    Select Case .Cells(i, "d").Value2: Case StDate To EndDate

							    Sheets("السلف").Cells(ii, "A").Resize(1, 12).Value = .Cells(i, "A").Resize(1, 12).Value

							    ii = ii + 1

					    End Select

			    End If

			    End If

	    Next

End With

End Sub

[رعد داود]

بسم الله الرحمن الرحيم

الشكر لكم أخي عبد الله على المجهود

أعتقد أني لم أوصل الفكره بصوره صحيحه فالذي أطلبه من الكود عندما أدخل في أحد الخلايا

b2.b3,b4,,,,,c2 ,,,,,,

ان تظهر لي الفلتره بأحد هذه الأختيارات أو كلها مجتمعه يعني اذا اكتب فقط السلف بدون ان ادخل شرط التاريخ او القسم يجلب لي السلف جميعها واذا أعطيت شرط القسم مثلا" يظهر نتائج القسم المطلوب فقط واذا اعطيته شرط التاريخين تظهر النتائج ايضا" سواء كل على انفراد او اجتماع شرطين او اكثر

وارفق الملف بالكود المعدل

solaf.rar

[رعد داود]

للرفع

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

السلام عليكم

جرب الكود التالي:

واشعرنا بالنتيجة

Sub Solaf()

Dim ib As Boolean

Dim tst1 As Integer, tst2 As Integer

Dim LastRow As Long, i As Long, ii As Long

Dim SText As String

Dim SText1 As String

Dim StDate As Double, EndDate As Double


With Sheets("السلف")

.Range("A7:L10000").ClearContents

SText = .Range("B2")

SText1 = .Range("C2")

If IsDate(.Range("B3")) And IsDate(.Range("B4")) Then

StDate = .Range("B3")

EndDate = .Range("B4")

Else: ib = True

End If

End With


ii = 7


With Sheets("yaomea")

LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow

If CStr(.Cells(i, "J")) = SText Then

'===============================

If Len(Trim(SText1)) = 0 Then tst1 = 1 Else tst1 = Abs(CStr(.Cells(i, "N")) = SText1)

'----------

If ib Then tst2 = 1 Else tst2 = Abs(.Cells(i, "d").Value2 >= StDate) * Abs(.Cells(i, "d").Value2 <= EndDate)

'===============================

If tst1 * tst2 Then

Sheets("السلف").Cells(ii, "A").Resize(1, 12).Value = .Cells(i, "A").Resize(1, 12).Value

ii = ii + 1

End If

End If

Next

End With

End Sub

المرفق 2003-2007

solaf.rar

[رعد داود]

بسم الله الرحمن الرحيم

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

الاستاذ الفاضل عبدالله خبور الذي كله خير

انا عندما اريد فقط جلب السلف كلها ولاأضع معيار اخر تجلب لي البيانات

ولو مسحت معيار السلف وادخلت فقط الفترتين تجلب لي البيانات

ولو مسحت المعايير وأدخلت فقط معيار القسم ايضا تجلب لي بيانات القسم المراد فقط لكافة بياناته

ولو ادخلت معيارين معا" مثل السلف مع احد الاقسام يجلب لي بيانات اليلف الخاصه بذلك القسم

هذا الذي اريده والكود الذي وضعته طبقته ولم يعمل معي لكوني قد لم اوضح بهذا الشكل قبل ذلك

جنابك جرب ان تزيل كل المعايير وتختار من الخليه سي 2 سوف لايجلب اي بيانات

[رعد داود]

استاذي الكريم الاستاذ خبور

هنا حضرتكم تشترط السلف معيار ثابت والباقيه متغيرات حسب الأختيار

والذي أوده هو كيفية جعل كل هذه المعايير غير ثابته ومستقله بعملها

لو طلب مني جلب اجمالي بتقرير السلف بدون تحديد اختار السلف وتظهر لي

ولو طلب مني تقرير بالسلف لفترتين ايضا هنا سوف يكون معياران للأختيار

ولو طلب مني فقط ان اظهر عهدة القسم فقط من خلال الاختيار من الكومبو سيظهر لي القسم على حده او اذا ارادوا عهدة القسم ولكن بين تاريخين او السلف التي بذمة القسم سأكتب السلف واعطي اختيار القسم وأحدد الفترتين وهكذا

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

استاذي الكريم الاستاذ خبور

هنا حضرتكم تشترط السلف معيار ثابت والباقيه متغيرات حسب الأختيار

والذي أوده هو كيفية جعل كل هذه المعايير غير ثابته ومستقله بعملها

لو طلب مني جلب اجمالي بتقرير السلف بدون تحديد اختار السلف وتظهر لي

ولو طلب مني تقرير بالسلف لفترتين ايضا هنا سوف يكون معياران للأختيار

ولو طلب مني فقط ان اظهر عهدة القسم فقط من خلال الاختيار من الكومبو سيظهر لي القسم على حده او اذا ارادوا عهدة القسم ولكن بين تاريخين او السلف التي بذمة القسم سأكتب السلف واعطي اختيار القسم وأحدد الفترتين وهكذا

بسيطة ان شاء الله

فقط عندي سؤال فيما اذا كانت لا توجد اي معايير

هل تريد جلب جميع البيانات

او ايقاف الكود في هذه الحالة ؟؟

الكود التالي

لا يشترط ايقاف البيانات في عدم وجود اي معايير

Sub Solaf()

Dim ib As Boolean

Dim tst As Integer, tst1 As Integer, tst2 As Integer

Dim LastRow As Long, i As Long, ii As Long

Dim SText As String

Dim SText1 As String

Dim StDate As Double, EndDate As Double


With Sheets("السلف")

    .Range("A7:L10000").ClearContents

    SText = .Range("B2")

    SText1 = .Range("C2")

    If IsDate(.Range("B3")) And IsDate(.Range("B4")) Then

        StDate = .Range("B3")

        EndDate = .Range("B4")

    Else: ib = True

    End If

End With


ii = 7


With Sheets("yaomea")

    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To LastRow

        '===============================

        If Len(Trim(SText)) = 0 Then tst = 1 Else tst = Abs(CStr(.Cells(i, "J")) = SText)

        If Len(Trim(SText1)) = 0 Then tst1 = 1 Else tst1 = Abs(CStr(.Cells(i, "N")) = SText1)

        If ib Then tst2 = 1 Else tst2 = Abs(.Cells(i, "d").Value2 >= StDate) * Abs(.Cells(i, "d").Value2 <= EndDate)

        '===============================

        If tst * tst1 * tst2 Then

            Sheets("السلف").Cells(ii, "A").Resize(1, 12).Value = .Cells(i, "A").Resize(1, 12).Value

            ii = ii + 1

        End If

    Next

End With

End Sub

[رعد داود]

بسم الله الرحمن الرحيم

استاذي العزيز واقعا" علم وفن جزيتم خيرا

هو الذي يفيدني والله يرعاكم هو السؤال والذي انا حاولت عليه بتغيير الكود ولم أفلح

هل من الممكن توضيح الكود ببساطه فأنا تعجبني كثيرا" اكوادكم بها سلاسه وسرعة عمل

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

[رعد داود]

وهناك سؤال اخر استاذي الكريم وهو كيف لي التحكم بالأعمده المراد جلب بياناتها في ورقة السلف

فقد لاأحتاج الى أعمده لأظهارها للأختصار ولكن هي تقع (1,12 أيضا" عندي فيها وقفه معكم اذا أمكن جواب وتلطف منكم

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

وهناك سؤال اخر استاذي الكريم وهو كيف لي التحكم بالأعمده المراد جلب بياناتها في ورقة السلف

فقد لاأحتاج الى أعمده لأظهارها للأختصار ولكن هي تقع (1,12 أيضا" عندي فيها وقفه معكم اذا أمكن جواب وتلطف منكم

افرد كل خلية بما يقابلها في البيانات

مثلا

Sheets("السلف").Cells(ii, "A").Value = .Cells(i, "A").Value

Sheets("السلف").Cells(ii, "B").Value = .Cells(i, "C").Value

[رعد داود]

مشكور استاذ على الرد والله يحفظكم من كل سوء ومكروه

هذا دعائي لكم من باطن الغيب