Trang 2/5 đầuđầu 1 2 3 4 5 cuốicuối
Hiển thị kết quả tìm kiếm từ 11 đến 20 trên tổng số: 42

Ðề tài: Giúp mình về dữ liệu lớn trong exel

  1. Trích Nguyên văn bởi HieuCD View Post
    bạn chạy thử code, trong đó nếu dữ liệu nguồn nếu nhiều thì nhập tiếp vào cột D và E, cùng hàng đầu cột A và B
    Code:
    Sub Vlookup()
    Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'On Error Resume Next
    LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
    If LastKQ < 4 Then
        MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
    End If
    Set Dic = CreateObject("scripting.dictionary")
    Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
    With ActiveWorkbook.Sheets("NNT")
      LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
      If LastNg < 4 Then
        MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
      End If
      Darr = .Range("A4:B" & LastNg).Value
      For i = 1 To UBound(Darr)
        Dic.Add Darr(i, 1), Darr(i, 2)
      Next i
    ' du lieu nhieu, nhap them vao cot D va E
      LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
      If LastNg >= 4 Then
        Darr = .Range("A4:B" & LastNg).Value
        For i = 1 To UBound(Darr)
          Dic.Add Darr(i, 1), Darr(i, 2)
        Next i
      End If
    End With
    ActiveWorkbook.Close False
    
    
    Darr = Range("A4:A" & LastKQ).Value
    ReDim Arr(1 To UBound(Darr), 1 To 1)
    For i = 1 To UBound(Arr)
      Arr(i, 1) = Dic.Item(Darr(i, 1))
    Next i
    Range("B4").Resize(UBound(Arr)) = Arr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub
    Mình vừa test thử bằng cách bỏ dữ liệu và cột D và E thì báo lỗi run time 457. Bạn Hiếu kiểm tra giúp mình với và mình có thử nếu nhỡ file dữ liệu có trùng dữ liệu thì khi chạy nó cũng báo lỗi như trên, bạn có thể code thêm nếu có trùng dữ liệu tìm kiếm tức có 2 dòng Mã giống nhau thì vẫn cho ra kq 1 trong 2 cái và nếu như tìm không có mã thì vẫn view ra cột tên trong file Phiếu ( view câu "khong co"). Cảm ơn bạn Hiếu nhiều lắm.

  2. Trích Nguyên văn bởi vnlife2000 View Post
    Mình vừa test thử bằng cách bỏ dữ liệu và cột D và E thì báo lỗi run time 457. Bạn Hiếu kiểm tra giúp mình với và mình có thử nếu nhỡ file dữ liệu có trùng dữ liệu thì khi chạy nó cũng báo lỗi như trên, bạn có thể code thêm nếu có trùng dữ liệu tìm kiếm tức có 2 dòng Mã giống nhau thì vẫn cho ra kq 1 trong 2 cái và nếu như tìm không có mã thì vẫn view ra cột tên trong file Phiếu ( view câu "khong co"). Cảm ơn bạn Hiếu nhiều lắm.
    bạn chỉnh lại code
    lưu ý chổ màu đỏ chỉ chọn 1 trong 2 và giống nhau của cả 2 đoạn lệnh
    Code:
    Sub Vlookup()
    Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long, Tmp
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'On Error Resume Next
    LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
    If LastKQ < 4 Then
        MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
    End If
    Set Dic = CreateObject("scripting.dictionary")
    Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
    With ActiveWorkbook.Sheets("NNT")
      LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
      If LastNg < 4 Then
        MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
      End If
      Darr = .Range("A4:B" & LastNg).Value
      For i = 1 To UBound(Darr)
        Tmp = Darr(i, 1)
    'Ban chon mot trong 2 cách lay giá tri dau hoac cuoi, o 2 dong lenh duoi
        If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau
        'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi
      Next i
    ' du lieu nhieu, nhap them vao cot D va E
      LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
      If LastNg >= 4 Then
        Darr = .Range("D4:E" & LastNg).Value
        For i = 1 To UBound(Darr)
          Tmp = Darr(i, 1)
    'Ban chon mot trong 2 cách lay giá tri o 2 dong lenh duoi
          If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau
          'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi
        Next i
      End If
    End With
    ActiveWorkbook.Close False
    
    
    Darr = Range("A4:A" & LastKQ).Value
    ReDim Arr(1 To UBound(Darr), 1 To 1)
    For i = 1 To UBound(Arr)
      Tmp = Darr(i, 1)
      If Dic.exists(Tmp) Then
        Arr(i, 1) = Dic.Item(Darr(i, 1))
      Else
        Arr(i, 1) = "Khong Co"
      End If
    Next i
    Range("B4").Resize(UBound(Arr)) = Arr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

  3. Trích Nguyên văn bởi HieuCD View Post
    bạn chỉnh lại code
    lưu ý chổ màu đỏ chỉ chọn 1 trong 2 và giống nhau của cả 2 đoạn lệnh
    Code:
    Sub Vlookup()
    Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long, Tmp
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'On Error Resume Next
    LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
    If LastKQ < 4 Then
        MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
    End If
    Set Dic = CreateObject("scripting.dictionary")
    Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
    With ActiveWorkbook.Sheets("NNT")
      LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
      If LastNg < 4 Then
        MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
      End If
      Darr = .Range("A4:B" & LastNg).Value
      For i = 1 To UBound(Darr)
        Tmp = Darr(i, 1)
    'Ban chon mot trong 2 cách lay giá tri dau hoac cuoi, o 2 dong lenh duoi
        If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau
        'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi
      Next i
    ' du lieu nhieu, nhap them vao cot D va E
      LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
      If LastNg >= 4 Then
        Darr = .Range("D4:E" & LastNg).Value
        For i = 1 To UBound(Darr)
          Tmp = Darr(i, 1)
    'Ban chon mot trong 2 cách lay giá tri o 2 dong lenh duoi
          If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau
          'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi
        Next i
      End If
    End With
    ActiveWorkbook.Close False
    
    
    Darr = Range("A4:A" & LastKQ).Value
    ReDim Arr(1 To UBound(Darr), 1 To 1)
    For i = 1 To UBound(Arr)
      Tmp = Darr(i, 1)
      If Dic.exists(Tmp) Then
        Arr(i, 1) = Dic.Item(Darr(i, 1))
      Else
        Arr(i, 1) = "Khong Co"
      End If
    Next i
    Range("B4").Resize(UBound(Arr)) = Arr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub
    Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.

  4. Trích Nguyên văn bởi vnlife2000 View Post
    Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.
    vụ % nầy mình không rành, chỉ hiện thông báo thôi
    Tập tin đính kèm Tập tin đính kèm

  5. Hiện thông báo cũng được bạn ạ. bạn giúp mình code với.

  6. Trích Nguyên văn bởi vnlife2000 View Post
    Hiện thông báo cũng được bạn ạ. bạn giúp mình code với.
    bạn xem file ở bài trên

  7. Bạn Hiếu xem file này có thanh trạng thái %, mình có thể kết hợp với code này được không ạ, cảm ơn bạn Hiếu.
    http://www.mediafire.com/file/925z0hod74oiwrb/Thanh-trang-thai_sao_chep.xlsm

  8. Trích Nguyên văn bởi vnlife2000 View Post
    Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.
    Thử code mới (vẫn dựa chính trên code của bác HieuCD, nên tên file và bố trí dữ liệu vẫn vậy) này với dữ liệu lớn xem có nhanh lên không

    hiện file kèm để cả 2 code

    code cũ - sao xanh - chạy cho thời gian ở C1
    code mới - sao vàng - chạy cho thời gian ở D1

    Bạn thử chạy xem có cải thiện tốc độ chút nào không ? có tới 3 phút không? so sánh xem

    Sau đó nếu cần thì gắn % thêm sau
    Tập tin đính kèm Tập tin đính kèm

  9. Trích Nguyên văn bởi winvista View Post
    Thử code mới (vẫn dựa chính trên code của bác HieuCD, nên tên file và bố trí dữ liệu vẫn vậy) này với dữ liệu lớn xem có nhanh lên không

    hiện file kèm để cả 2 code

    code cũ - sao xanh - chạy cho thời gian ở C1
    code mới - sao vàng - chạy cho thời gian ở D1

    Bạn thử chạy xem có cải thiện tốc độ chút nào không ? có tới 3 phút không? so sánh xem

    Sau đó nếu cần thì gắn % thêm sau
    Cảm ơn bạn winvista, mình vừa chạy code bạn và đúng là nhanh hơn đáng kể: 251s vs 23s. Bạn giúp mình gắn % với ạ. Cảm ơn bạn winvista và bạn Hiếu nhiều lắm.

  10. Trích Nguyên văn bởi vnlife2000 View Post
    Cảm ơn bạn winvista, mình vừa chạy code bạn và đúng là nhanh hơn đáng kể: 251s vs 23s. Bạn giúp mình gắn % với ạ. Cảm ơn bạn winvista và bạn Hiếu nhiều lắm.
    Đã gắn ProgressBar % . Nó sẽ làm chậm chương trình đi 1 chút đó,

    Nếu vẫn thích thì lấy cái file kèm này, nhưng tôi nghĩ 23s là đợi tốt
    Tập tin đính kèm Tập tin đính kèm
    thay đổi nội dung bởi: winvista, 17-02-17 lúc 08:08 PM

Trang 2/5 đầuđầu 1 2 3 4 5 cuốicuối

Thông tin về chủ đề này

Users Browsing this Thread

Hiện có 1 người đang xem đề tài này. (0 thành viên và 1 khách)

Bookmarks

Bookmarks

Quyền Sử Dụng Ở Diễn Ðàn

  • Bạn không thể đăng đề tài mới
  • Bạn không thể đăng trả lời
  • Bạn không thể đăng file đính kèm.
  • Bạn không thể sửa bài viết.
  •