سؤال حول تصدير البيانات من والى ملف مغلق

[ابن الملك]

السادة اساتذتى فى موقعنا الكريم 

 

لقد قرأت موضوع الاستاذ مختار عن ترحيل بيانات من ملف مغلق الى ملف مغلق 

ولكن لقد قمنا بتفعيل هذه الخاصية فى ترحيل بيانات الشيكات المسمى هنا بأسم |From الى شيت البنك المسمى هنا بأسم to 

ولكن أريد ان أخبر البرنامج انه أذا كان هناك نفس رقم الشيك لا يقوم بترحيل بياناته الى الشيت الثانى المسمى To

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

 

وشكرا لكم جزيلا

Export Data.rar

تم تعديل يناير 20, 2015 بواسطه ابن الملك

[ابن الملك]

للرفع

 

للرفع

[مختار حسين محمود]

مرة أخرى أعتذر لك   لم أر رسالة الخاص الا بالأمس

 

 وأنا منذ يناير الماضى لم أدخل الموقع 

 

تم التعديل فى مسار الملف واسمه 

 

المسار الذى اخترته غالبا تحدث به أخطاء لأن الملفات هناك تصبح للقراءة فقط

 

كما أن اسم الملف to   لا يعجب الفيجوال بيسك    لانها بالنسبة اليه حرف جر انجليزى بمعنى الى

 

تذكر أن المدى الذى حددته فى الملف from  يذهب الى الملف  output    كاملا

 

أما بالنسبة للنقطة اذا كان هناك نفس رقم الشيك لا يقوم بترحيل بياناته الى الشيت الثانى  اصبر علىّ فيها

 

تقبل تحياتى

Book2.rar

تم تعديل مارس 12, 2015 بواسطه مختار حسين محمود

[مختار حسين محمود]

فكرة سريعة جاتنى  بالنسبة للنقطة ( اذا كان هناك نفس رقم الشيك لا يقوم بترحيل بياناته الى الشيت الثانى )

وهى رحل كل المدى عادى الى الشيت الثانى وهناك هنحذف الصفوف المكررة بالكود التالى

Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' هذا الكود لحذف الصفوف المكررة

' لتشغيل الكود قف على أول خليه فى  العمود الخاص برقم الشيك ثم شغل الكود

'الكود سوف يبحث فى العمود عن ارقام الشيكات المتماثلة ويحذف الصف المكرر
.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value

If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub

تم تعديل مارس 12, 2015 بواسطه مختار حسين محمود