ارجو مساعدتي بكشف حساب حسب اسم العميل واسم المخزن بالكواد

[مهند محسن]

السلام عليكم اخوتي في هذا المنتدى العملاق

ارجو مساعدتي بعمل كشف بالكواد..

كشف حساب  حسب اسم العميل واسم المخزن  

ولكم فائق الشكر

كشف حساب عميل.rar

[ابراهيم الحداد]

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

فى حالة عدم وجود اسم العميل او اسم المخزن لن يعمل معك الكود

اليك الكود

Sub StatmentCS()
Dim ws As Worksheet, Sh As Worksheet
Dim CusmName As String, StorName As String
Dim Arr As Variant, Temp As Variant
Dim LR As Long, i As Long, j As Long, p As Long
Set ws = Sheets("ورقة1")
Set Sh = Sheets("ورقة2")
StorName = Sh.Range("C2")
CusmName = Sh.Range("F2")
LR = ws.Range("D" & Rows.Count).End(xlUp).Row
Sh.Range("A5:L" & Sh.Range("D" & Rows.Count).End(xlUp).Row + 1).ClearContents
Arr = ws.Range("A5:L" & LR).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 12) = StorName And Arr(i, 4) = CusmName Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Temp(p, j) = Arr(i, j)
Next
End If
Next
If p > 0 Then Sh.Range("A5").Resize(p, UBound(Temp, 2)).Value = Temp
End Sub

 

تم تعديل أبريل 13, 2018 بواسطه زيزو العجوز

[Ali Mohamed Ali]

بارك الله فيك أستاذنا زيزو كود ممتاز جعله الله فى ميزان حسناتك

ولا اثراء الموضوع اليك كود أخر

 

كشف حساب عميل حسب المخزن - Copy.xlsm

[احمدزمان]

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

بعد الشكر و التقدير لكلا من اخوني الأفاضل زيزو و ali

على الحلول الصحيحة و الرائعة التي قدموها

================================

هذا حل ثالث 

باستخدام التصفية المتقدمة بالكود

اولا : الخانات الحمراء مهمة جدا لعمل الكود

ثانيا : لن يقف في طريقك اي معلومة ناقصة

اذا ادخلت اسم العميل فقط = تظهر لك بيانات هذا العميل في جميع المخازن

اذا ادخلت اسم المخزن و تركت خانة اسم العميل فارغة = تظهر لك كل بيانات هذا المخزن لكل العملاء

اذا تركت كلتا الخانتين فارغة = تظهر لك كل البيانات الموجودة في ورقة 1

Sub srsh()
Dim RN1 As Range, RN2 As Range, RN3 As Range
Set RN1 = Sheets("æÑÞÉ1").Range("A4:L99")
Set RN2 = Sheets("æÑÞÉ2").Range("K1:L2")
Set RN3 = Sheets("æÑÞÉ2").Range("A4:L99")
RN1.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=RN2, CopyToRange:=RN3, Unique:=False
End Sub

 

كشف حساب عميل حسب المخزن.xlsm

[مهند محسن]

الشكر الجزيل للاستاذ زيزو والشكر الجزيل للاستاذ احمد زمان والاستاذ علي محمد  على هذه المساعدة القيمة

اتمنى لكم كل الموفقية ان شاء الله ولكم فائق الشكر والتقدير...