أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





التحقق من بيانات في عمودين قبل الاضافة

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريبالسلام عليكم ورحمة الله وبركاته تكرماً لدي استفسار عندي جدول فيه ..



14-02-2020 01:07 مساء
solnaif
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 21-01-2020
رقم العضوية : 17736
المشاركات : 8
الجنس : ذكر
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 18
 offline 

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريبالسلام عليكم ورحمة الله وبركاته 
تكرماً لدي استفسار عندي جدول فيه مجموعة من البيانات وهي 
رقم العميل (A)  تاريخ اليوم (َB)  واسم العميل (C) والبضاعة التي تم شراؤها (D)  والذي أريده أن أتحقق قبل إضافة أي بيانات بأن العميل لم تضاف بياناته في نفس اليوم وللتوضيح  أكثر لا أريد أن أسجل العميل مرتين في نفس اليوم - واعتقد يكون ذلك بالتحقق من تاريخ اليوم ورقم العميل انا عملت الكود التالي ولكن لم يجدي نفعاً فهل من الممكن مساعدتي في ذلك وذلك من خلال vba

Code = txtCode.Value
DateDay= txtDate.Value
If Application.WorksheetFunction.CountIfs(Worksheets("Sheet1").Range("A2:A100"), "<>" & (Code), Worksheets("Sheet1").Range("B2:B100"), "<>" & (DateDay)) Then
 Range("A" & Lastrow).Value = txtCode.Value
Range("B" & Lastrow).Value = txtDate
Range("C" & Lastrow).Value = txtName
Range("D" & Lastrow).Value = txtG.Value
  Else
 MsgBox ("تم اضافة البيانات لهذا اليوم")
 End If
 
 
  العملاء.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(24.239) KB


14-02-2020 02:03 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
وعليكم السلام أخي الكريم
يرجى إرفاق ملف لتجد مساعدة أفضل من إخوانك بالمنتدى

14-02-2020 02:46 مساء
مشاهدة مشاركة منفردة [2]
solnaif
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 21-01-2020
رقم العضوية : 17736
المشاركات : 8
الجنس : ذكر
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 18
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
ابشر بعزك الله يسعدك

14-02-2020 09:56 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
جرب تغيير السطر التالي
If Application.WorksheetFunction.CountIfs(Worksheets("Sheet1").Range("B2:B100"), Code, Worksheets("Sheet1").Range("D2:D100"), DateDay) = 0 Then

15-02-2020 04:51 مساء
مشاهدة مشاركة منفردة [4]
solnaif
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 21-01-2020
رقم العضوية : 17736
المشاركات : 8
الجنس : ذكر
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 18
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
السلام عليكم ورحمة الله وبركاته
الله يجزاكم خير 
ولكن الكود لم يعمل بالشكل الصحيح
فنرجو المساعدة وجزاكم الله كل خير

15-02-2020 05:54 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
وعليكم السلام
جربت الكود بعد هذا التعديل وعمل معي بشكل صحيح فقط إذا لم توجد بيانات لهذا العميل في هذا التاريخ
ربما لو ذكرت مثال لما تحاول القيام به بالضبط يكون أفضل لنقوم بمحاكاة المشكلة لدينا

15-02-2020 06:32 مساء
مشاهدة مشاركة منفردة [6]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif التحقق من بيانات في عمودين قبل الاضافة
ممكن استعمال الماكرو الاول Compair_rows لتحديد التكرارات
والماكرو الثاني del_Duplicates لحذفها
 بذلك يمكنك العمل كيفما تشاء و في النهاية تحدد المكرر وتقوم بحذفه 

Option Explicit
Sub Compair_rows()
'First macro
With Sheets("sheet1")
       .Range("A1").CurrentRegion.Offset(1).Interior.ColorIndex = xlNone
       .Range("G:G").ClearContents
  Dim i%, j%, arr1, arr2, k%, m%, Ro%
  Ro = .Cells(Rows.Count, 2).End(3).Row
      For i = 2 To Ro
          arr1 = Application.Transpose(.Cells(i, 2).Resize(, 4).Value)
          arr1 = Application.Transpose(arr1)
          For j = i + 1 To Ro
              arr2 = Application.Transpose(.Cells(j, 2).Resize(, 4).Value)
              arr2 = Application.Transpose(arr2)
                  For k = LBound(arr1) To UBound(arr2)
                    If arr1(k) <> arr2(k) Then
                       m = 0
                       Exit For
                    Else
                      m = m + 1
                    End If
                  Next k
              If m = 4 Then
              .Cells(j, 7) = "Duplicate with : " & Cells(i, 2).Resize(, 4).Address
              .Cells(j, 1).Resize(, 5).Interior.ColorIndex = 6
              End If
          Next j
          m = 0
      Next i
  End With
End Sub
'+++++++++++++++++++++++++++++++++++
'Seconde Macro
Sub del_Duplicates()
 Sheets("sheet1").Range("G:G").SpecialCells(2).EntireRow.Delete
End Sub


 الملف مرفق للمعاينة


 
 
 
  Castomers.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(33.458) KB





الكلمات الدلالية
التحقق ، بيانات ، عمودين ، الاضافة ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 02:34 صباحا