أكاديمية الصقر للتدريب
موضوع بعنوان :تعديل كود استدعاء من ملف مغلق الحلقة التكرارية تجعله ياخد وقت طويل جدااا
الكاتب :omhamzh


السلام عليكم ممكن
تعديل كود استدعاء من ملف مغلق الحلقة التكرارية تجعله ياخد وقت طويل جدااا اذا كان عدد الصفوف 10000 او اكثر
ربنا يرضى عنكم
Option Explicit

Sub GetDataDemo()

      Dim FilePath$, Row&, Column&, Address$
      Dim mpth
      Dim mfL
      'change constants & FilePath below to suit
      '***************************************
      Const FileName$ = "**"
      Const SheetName$ = "ورقة1"
      Const NumRows& = 10
      Const NumColumns& = 10
      Dir (mpth & "*xls*")
      mpth = ThisWorkbook.Path & "\do\"
      mfL = Dir(mpth & "*xls*")
      '***************************************
      
      DoEvents
      Application.ScreenUpdating = False
      If Dir(mpth & mfL) = Empty Then
            MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
            Exit Sub
      End If
      For Row = 1 To NumRows
            For Column = 1 To NumColumns
                  Address = Cells(Row, Column).Address
                  Cells(Row, Column) = GetData(mpth, mfL, SheetName, Address)
                  Columns.AutoFit
            Next Column
      Next Row
      ActiveWindow.DisplayZeros = False
End Sub

Private Function GetData(Path, File, Sheet, Address)
      Dim Data$
      Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
            Range(Address).Range("A1").Address(, , xlR1C1)
      GetData = ExecuteExcel4Macro(Data)
End Function