استدعاء بيانات من ملفات مختلفة

[وائل عبد الصمد]

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

تحية طيبة لأخوانى الأعزاء بالمنتدى وجزاكم الله خيرا على تعاونكم معنا - جعله الله في ميزان حسناتكم

وبعد,,,

عندى 3 ملفات منفصلة :- ملف بإسم مطابقة - ملف بإسم عملاء - ملف بإسم رصيد عملاء

أحتاج الى المقارنة بين ملف عملاء و رصيد عملاء ( من حيث كميات المنتجات المباعة ) حيث يحتوى كل ملف منهم على عشرات الشركات .

الدالة التى اعرفها للقيام بالمقارنة هى دالة VLOOKUP

وحتى استطيع استخدام  دالة VLOOKUP يجب الإستعانة بملف وسيط ( مطابقة ) يظهر به بيانات ملف ( عملاء ) و ملف ( رصيد عملاء ) حتى أستطيع المقارنة بينهم.

المطلوب

1- فى ملف (المطابقة) فى الخلية ( a1 ) عند اختيار اسم الشركة من القائمة المنسدلة يتم ترحيل البيانات الموجودة فى ملف ( عملاء ) بالجدول الملون ( Code المنتج يناير فبراير مارس أبريل مايو يونيو يوليو أغسطس سبتمبر أكتوبر نوفمبر ديسمبر الإجمالى )

2- فى ملف (المطابقة) فى الخلية ( R1 ) عند اختيار اسم الشركة من القائمة المنسدلة يتم ترحيل البيانات الموجودة فى ملف ( رصيد عملاء ) بالجدول الملون ( كود المنتج -  المنتج - يناير فبراير مارس أبريل مايو يونيو يوليو أغسطس سبتمبر أكتوبر نوفمبر ديسمبر الإجمالى )

3- ان أمكن ذلك فى حالة تحديث الأرقام فى أى من ملف ( عملاء ) و ( رصيد عملاء ) يتم تحديث البيانات تلقائيا فى ملف ( المطابقة )

أعتذر عن الإطالة وكل عام وانتم بصحة وسعادة يارب

إستدعاء بيانات.rar

[Saleh Ahmed Rabie]

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

**أخي الكريم،**

**يسعدني مساعدتك في حل مشكلتك.**

**إليك الخطوات اللازمة لإنشاء ملف مطابقة لمقارنة كميات المنتجات المباعة بين ملفات العملاء ورصيد العملاء باستخدام دالة VLOOKUP:**

**1. إنشاء ملف مطابقة:**

* افتح ملف Excel جديدًا وأطلق عليه اسم "مطابقة".
* في الخلية A1، قم بإنشاء قائمة منسدلة تحتوي على أسماء الشركات الموجودة في ملفات العملاء ورصيد العملاء.

**2. استرداد بيانات العملاء:**

* في الخلية B1، استخدم دالة VLOOKUP لاسترداد بيانات العملاء من ملف "عملاء" بناءً على اسم الشركة المحدد في الخلية A1.
* استخدم الصيغة التالية:
```
=VLOOKUP(A1,'عملاء'!$A$1:$M$100,2,FALSE)
```
* حيث:
    * A1: الخلية التي تحتوي على اسم الشركة المحدد.
    * 'عملاء'!$A$1:$M$100: نطاق البيانات في ملف "عملاء" الذي يحتوي على أسماء الشركات وكميات المنتجات المباعة.
    * 2: رقم العمود الذي يحتوي على كميات المنتجات المباعة.
    * FALSE: قيمة منطقية تشير إلى مطابقة دقيقة.

**3. استرداد بيانات رصيد العملاء:**

* في الخلية R1، استخدم دالة VLOOKUP لاسترداد بيانات رصيد العملاء من ملف "رصيد عملاء" بناءً على اسم الشركة المحدد في الخلية A1.
* استخدم الصيغة التالية:
```
=VLOOKUP(A1,'رصيد عملاء'!$A$1:$M$100,2,FALSE)
```
* حيث:
    * A1: الخلية التي تحتوي على اسم الشركة المحدد.
    * 'رصيد عملاء'!$A$1:$M$100: نطاق البيانات في ملف "رصيد عملاء" الذي يحتوي على أسماء الشركات وكميات المنتجات المباعة.
    * 2: رقم العمود الذي يحتوي على كميات المنتجات المباعة.
    * FALSE: قيمة منطقية تشير إلى مطابقة دقيقة.

**4. التحديث التلقائي للبيانات:**

* لضمان تحديث البيانات تلقائيًا عند تحديث ملفات العملاء ورصيد العملاء، استخدم صيغ VLOOKUP مع روابط الملفات المطلقة.
* على سبيل المثال، لتحديث بيانات العملاء، استخدم الصيغة التالية:
```
=VLOOKUP(A1,'[مسار ملف العملاء]'!$A$1:$M$100,2,FALSE)
```
* حيث:
    * '[مسار ملف العملاء]': المسار الكامل لملف "عملاء".
* قم بتكرار الخطوة نفسها لبيانات رصيد العملاء.

**بمجرد إعداد ملف المطابقة، يمكنك استخدامه لمقارنة كميات المنتجات المباعة بين ملفات العملاء ورصيد العملاء بسهولة.**

 

[وائل عبد الصمد]

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

لم أنجح فى تطبيق الحل 

حيث ان .=VLOOKUP(A1,'[مسار ملف العملاء]'!$A$1:$M$100,2,FALSE) لم يقبلها ملف الإكسيل ويطلب تحديد الشيت من الملف

لو فى امكانية حضرتك تبعت الحل فى ملف مرفق أكون شاكر لك جزيل الشكر

[طارق محمود]

السلام عليكم
قد يكون الحل أسهل بالأكواد

[محمد هشام.]

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

كما سبق الذكر من طرف  الأستاذ @طارق محمود أنسب طريقة لتنفيد طلبك على ما أعتقد هي إستخدام الأكواد خاصة إذا كانت لك رغبة بالإشتغال على الملفات وهي مغلقة مع وضع  عدة معايير للتحقق   

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

Sub CopyData()  '''''''''( رصيد عملاء Workbook )
Dim FileName$, Path$, wbSource$, rng As Range, FilePath$, sPath$
Dim src As Worksheet: Set src = Sheets("1")
Path = ThisWorkbook.Path
wbSource = "رصيد عملاء.xlsx": FileName = src.[A1]
If FileName = "" Then: Exit Sub
' التححق من وجود المصنف
    FilePath = Path & "\" & wbSource
    If Len(Dir(FilePath)) = 0 Then
  MsgBox "الملف غير موجود", vbExclamation, wbSource: Exit Sub
End If
' التححق من وجود ورقة العمل
  sPath = ActiveWorkbook.Path & "\"
  If Not Verification(sPath, wbSource, FileName) Then
    MsgBox wbSource & " " & " الورقة " & " : " & FileName & " غير موجودة على مصنف", vbInformation: Exit Sub
  End If

With Application
.ScreenUpdating = False
.DisplayAlerts = False

 src.Range("B3:P" & src.Rows.Count).ClearContents
 
    a = "B3:B300": b = "C3:C300": c = "D3:P300"   '<<===== ' Paste data(المطابقة)
    Cnt = "Q12:Q300": Cnt2 = "S12:S300": Cnt3 = "CB12:CN300"  '<<===== 'Data range(رصيد عملاء)
  
  'كود المنتج
  src.Range(a).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt
  'المنتج
  src.Range(b).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt2
  ' من يناير الى الإجمالى
  src.Range(c).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt3

ling = src.UsedRange.Rows.Count: Set rng = src.Range("B3:P" & ling)
With rng
   .Value = .Value: .Borders.LineStyle = xlNone
   .Replace "#N/A", "", xlWhole: .Replace "0", "", xlWhole
 End With
' Underline the rows Sheets("1")
For Each c In rng.Rows
   If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous
Next

.ScreenUpdating = False
.DisplayAlerts = False
 End With
End Sub

 

Sub CopyData2() '''''''''''''( عملاء Workbook )
Dim FileName$, Path$, wbSource$, rng As Range, FilePath$, sPath$
Dim src As Worksheet: Set src = Sheets("1")
Path = ThisWorkbook.Path
wbSource = "عملاء.xlsx": FileName = src.[R1]
If FileName = "" Then: Exit Sub 
    FilePath = Path & "\" & wbSource
    If Len(Dir(FilePath)) = 0 Then
  MsgBox "الملف غير موجود", vbExclamation, wbSource: Exit Sub
End If  
  sPath = ActiveWorkbook.Path & "\"
  If Not Verification(sPath, wbSource, FileName) Then
    MsgBox wbSource & " " & " الورقة " & " : " & FileName & " غير موجودة على مصنف", vbInformation: Exit Sub
  End If

With Application
.ScreenUpdating = False
.DisplayAlerts = False
  src.Range("S3:AG" & src.Rows.Count).ClearContents
        a = "S3:S300": b = "T3:T300": c = "U3:AG300"   '<<===== ' Paste data(المطابقة)
        Cnt = "Y4:Y300": Cnt2 = "Z4:Z300": Cnt3 = "FK4:FW300" '<<===== 'Data range(عملاء)
  'كود المنتج
  src.Range(a).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt
  'المنتج
  src.Range(b).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt2
  ' من يناير الى الإجمالى
  src.Range(c).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt3
    
ling = src.UsedRange.Rows.Count: Set rng = src.Range("S3:AG" & ling)
With rng
   .Value = .Value: .Borders.LineStyle = xlNone
   .Replace "#N/A", "", xlWhole: .Replace "0", "", xlWhole
 End With
' Underline the rows Sheets("1")
For Each c In rng.Rows
  If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous
Next
.ScreenUpdating = False
.DisplayAlerts = False
End With
End Sub

Function Verification(fPath As String, fName As String, sheetName As String)
  Dim f As String
  f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
  Verification = Not IsError(Application.ExecuteExcel4Macro(f))
End Function

 

Sheets("1")   وفي حدث 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Select Case Target.Address(0, 0)
    Case "A1": Call CopyData: Case "R1": Call CopyData2
    Target.Select
    Case Else: Exit Sub
End Select
End Sub

Workbook event

Private Sub Workbook_Open()
Call CopyData: Call CopyData2
End Sub

 

إستدعاء بيانات.zip

[mahmoud nasr alhasany]

احسنت ا/ محمد هشام انت رائع حقا حفظك الله