اذهب الي المحتوي
أوفيسنا

بحث بين تاريخين


tlayt kamal
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

المطلوب فضلا وليس امرا

ماكرو

عند ادخال رقم العميل في H2

و التاريخ من في I2

والتاريخ الى في J2

ترحل البيانات من شيت1 الى شيت2 

حفظكم الله

 

DT.xlsm

رابط هذا التعليق
شارك

  • أفضل إجابة

جرب هذا الكود

Option Explicit
Private Sub Worksheet_Activate()
fil_dat_val
End Sub
'+++++++++++++++++++++++++++++++++++
Sub fil_dat_val()
Application.ScreenUpdating = False
Dim I%: I = 6
Dim arr
Dim rg As Object
Set rg = CreateObject("system.collections.arraylist")
With rg
 Do Until Sheets("sheet1").Range("B" & I) = vbNullString
  If Not .contains(Sheets("sheet1").Range("A" & I).Value) Then _
  .Add Sheets("sheet1").Range("A" & I).Value
 I = I + 1
 Loop
 .Sort
 arr = .toarray
 arr = Join(arr, ",")
 End With
 
 With Sheets("sheet2").Range("H2").Validation
 .Delete
 .Add xlValidateList, Formula1:=arr
  End With
End Sub
'==============================
Sub get_values()
Dim rg As Object, I%, m%, kY
Dim Sh1 As Worksheet, Sh2 As Worksheet
I = 6
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Set rg = CreateObject("Scripting.dictionary")
Sh2.Range("a6").CurrentRegion.Offset(1).Clear
With Sh1
 Do Until Not IsNumeric(.Range("a" & I))
      If .Range("A" & I) = Sh2.Range("h2") _
       And .Range("C" & I) >= Sh2.Range("I2") _
       And .Range("C" & I) <= Sh2.Range("J2") Then
       rg(m) = _
        .Range("C" & I).Value & "*" & _
        .Range("D" & I).Value & "*" & _
        .Range("E" & I).Value
        m = m + 1
      End If
       I = I + 1
  Loop
  End With
  If rg.Count = 0 Then GoTo End_Me
  m = 6
  For Each kY In rg.keys
      Sh2.Cells(m, 1).Resize(, 3) = _
      Split(rg(kY), "*"): m = m + 1
  Next
    With Sh2.Range("A6:C" & m - 1)
        .Value = .Value
        .InsertIndent 1
        .Borders.LineStyle = 1
        .Font.Size = 14
    End With
End_Me:
  Application.ScreenUpdating = True
 Set rg = Nothing
End Sub

 

Saerch_by_date.xlsm

  • Like 3
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information