Chuyên đề Bài tập VBA

SA_DQ · 19/1/12

Bài I: Chuyển dữ liệu từ 1 bảng tổng hợp

Số liệu ban đầu như sau:

(Bảng 1)

Giờ muốn có 1 macro để chuyển bảng dữ liệu này thành bảng sau:

(Bảng 2)

Bài II: Hãy giúp tôi chuyển dữ liệu từ bảng 2 thành bảng 1

(húc Mừng Xuân Mới!

Quang_Hải · 12/1/13

ndu96081631 đã viết:
Giải thuật này gần giống với giải thuật sort mảng (thời xa xưa)... Cũng 2 vòng lập chạy đi chạy lại
Hic... dữ liệu 60000 dòng chắc phải đợi đi đám cưới của tungnguyen về hy vọng nó mới chạy xong!
Ẹc... Ẹc...

Em cũng biết vậy nhưng tại tìm giải thuật cho vui và để tập suy nghĩ thôi. Chứ ai tội gì tự làm khổ mình như thế này chứ.

Quang_Hải · 12/1/13

ndu96081631 đã viết:
Giải thuật này gần giống với giải thuật sort mảng (thời xa xưa)... Cũng 2 vòng lập chạy đi chạy lại
Hic... dữ liệu 60000 dòng chắc phải đợi đi đám cưới của tungnguyen về hy vọng nó mới chạy xong!
Ẹc... Ẹc...

Em chứng minh cho anh thấy rằng cách này em xử lý dữ liệu 65000 dòng trong 3 giây là xong
Đàn em của anh càng ngày càng bớt dốt rồi mà.

PHP:

Sub loc_duy_nhat_lay_max_khong_dung_dic()
Dim arr(), i As Long, result(), j As Long, n As Long, m As Long, result2()
Dim t As Double
t = Timer
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
For i = 1 To UBound(arr)
      If m > 0 Then
         For j = 1 To m
            If arr(i, 1) = result(j) Then
               If result2(j) < arr(i, 3) Then result2(j) = arr(i, 3)
               n = 0:
               Exit For
            Else
               n = n + 1
            End If
         Next j
         If n Then
            m = m + 1
            ReDim Preserve result(1 To m)
            ReDim Preserve result2(1 To m)
            result(m) = arr(i, 1)
            result2(m) = arr(i, 3)
         End If
      Else
         m = m + 1
         ReDim Preserve result(1 To m)
         ReDim Preserve result2(1 To m)
         result(m) = arr(i, 1)
         result2(m) = arr(i, 3)
      End If
Next
[H2].Resize(m) = Application.Transpose(result)
[I2].Resize(m) = Application.Transpose(result2)
MsgBox Timer - t
End Sub

Nếu anh cho rằng Transpose không tốt thì em xin xài code này

PHP:

Sub loc_duy_nhat_lay_max_khong_dung_dic2()
Dim arr(), i As Long, result(1 To 10000, 1 To 1), j As Long, n As Long, m As Long, result2(1 To 10000, 1 To 1)
Dim t As Double
t = Timer
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
For i = 1 To UBound(arr)
      If m > 0 Then
         For j = 1 To m
            If arr(i, 1) = result(j, 1) Then
               If result2(j, 1) < arr(i, 3) Then result2(j, 1) = arr(i, 3)
               n = 0:
               Exit For
            Else
               n = n + 1
            End If
         Next j
         If n Then
            m = m + 1
            result(m, 1) = arr(i, 1)
            result2(m, 1) = arr(i, 3)
         End If
      Else
         m = m + 1
         result(m, 1) = arr(i, 1)
         result2(m, 1) = arr(i, 3)
      End If
Next
[H2].Resize(m, 1) = result
[I2].Resize(m, 1) = result2
MsgBox Timer - t
End Sub

dhn46 · 12/1/13

Nếu chỉ dùng vòng lặp em cũng đóng góp 1 code

Mã:

Sub Gpe()
Dim i As Integer, arr, ArrKq, sArr, s As String
arr = Range("B2:D" & Range("B65536").End(3).Row)
For i = 1 To UBound(arr)
    If InStr(1, s, arr(i, 1)) = 0 Then
        s = s & arr(i, 1) & "-" & arr(i, 3) & ";"
    Else
        If Val(Mid(s, InStr(1, s, arr(i, 1)) + Len(arr(i, 1)) + 1, InStr(Right(s, Len(s) - InStr(1, s, arr(i, 1)) - 1), "-"))) < arr(i, 3) Then
            s = Replace(s, Mid(s, InStr(1, s, arr(i, 1)), InStr(Right(s, Len(s) - InStr(1, s, arr(i, 1))), ";")), arr(i, 1) & "-" & arr(i, 3))
        End If
    End If
Next
ReDim ArrKq(1 To UBound(arr), 1 To 2)


sArr = Split(";" & Left(s, Len(s) - 1), ";")
For i = 1 To UBound(sArr)
    ArrKq(i, 1) = Left(sArr(i), InStr(1, s, "-") - 1)
    ArrKq(i, 2) = Right(sArr(i), Len(sArr(i)) - Len(ArrKq(i, 1)) - 1)
Next
[f2].Resize(UBound(ArrKq), 2) = ArrKq
End Sub

--------------------------------------------
Ngồi rảnh e test Code với 65535 dòng trên cái máy tính cùi mà cho tốc độ khá quá : trên dưới 0.18 (s). Giải thuật này hay quá!

siwtom · 12/1/13

quanghai1969 đã viết:

PHP:

Sub loc_duy_nhat_lay_max_khong_dung_dic2()
Dim arr(), i As Long, result(1 To 10000, 1 To 1), j As Long, n As Long, m As Long, result2(1 To 10000, 1 To 1)
Dim t As Double
t = Timer
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
For i = 1 To UBound(arr)
      If m > 0 Then
         For j = 1 To m
            If arr(i, 1) = result(j, 1) Then
               If result2(j, 1) < arr(i, 3) Then result2(j, 1) = arr(i, 3)
               n = 0:
               Exit For
            Else
               n = n + 1
            End If
         Next j
         If n Then
            m = m + 1
            result(m, 1) = arr(i, 1)
            result2(m, 1) = arr(i, 3)
         End If
      Else
         m = m + 1
         result(m, 1) = arr(i, 1)
         result2(m, 1) = arr(i, 3)
      End If
Next
[H2].Resize(m, 1) = result
[I2].Resize(m, 1) = result2
MsgBox Timer - t
End Sub

Nếu mảng arr có 10.000 dòng thì đk "IF m > 0 THEN" được tính 10.000 lần. Mà ta biết rằng chỉ trừ lần đầu còn 9.999 lần sau thì đk thỏa, vậy chả lý gì lại mất "điện nước" như thế nên tôi sửa thành.

[GPECODE=vb]
Sub loc_duy_nhat_lay_max_khong_dung_dic2()
Dim arr(), i As Long, result(1 To 10000, 1 To 1), j As Long, n As Long, m As Long, result2(1 To 10000, 1 To 1)
Dim t As Double
t = Timer
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
m = 1
result(1, 1) = arr(1, 1)
result2(1, 1) = arr(1, 3)
For i = 2 To UBound(arr)
For j = 1 To m
If arr(i, 1) = result(j, 1) Then
If result2(j, 1) < arr(i, 3) Then result2(j, 1) = arr(i, 3)
n = 0:
Exit For
Else
n = n + 1
End If
Next j
If n Then
m = m + 1
result(m, 1) = arr(i, 1)
result2(m, 1) = arr(i, 3)
End If
Next
[H2].Resize(m, 1) = result
[I2].Resize(m, 1) = result2
MsgBox Timer - t
End Sub
[/GPECODE]

Nhìn kỹ thấy "n = n + 1" là hoàn toàn không cần thiết. Vậy sửa tiếp thành

[GPECODE=vb]
Sub loc_duy_nhat_lay_max_khong_dung_dic2()
Dim arr(), i As Long, result(1 To 10000, 1 To 1), j As Long, m As Long, result2(1 To 10000, 1 To 1)
Dim t As Double
t = Timer
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
m = 1
result(1, 1) = arr(1, 1)
result2(1, 1) = arr(1, 3)
For i = 2 To UBound(arr)
For j = 1 To m
If arr(i, 1) = result(j, 1) Then
If result2(j, 1) < arr(i, 3) Then result2(j, 1) = arr(i, 3)
Exit For
End If
Next j
If j > m Then
m = m + 1
result(m, 1) = arr(i, 1)
result2(m, 1) = arr(i, 3)
End If
Next
[H2].Resize(m, 1) = result
[I2].Resize(m, 1) = result2
MsgBox Timer - t
End Sub
[/GPECODE]

Nếu không muốn dùng j cho đk "IF j > m THEN" thì

Mã:

Sub loc_duy_nhat_lay_max_khong_dung_dic2()
Dim arr(), i As Long, result(1 To 10000, 1 To 1), j As Long, n As Long, m As Long, result2(1 To 10000, 1 To 1)
Dim t As Double
    t = Timer
    arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value    
    m = 1
    result(1, 1) = arr(1, 1)
    result2(1, 1) = arr(1, 3)    
    For i = 2 To UBound(arr)
        For j = 1 To m
           If arr(i, 1) = result(j, 1) Then
              If result2(j, 1) < arr(i, 3) Then result2(j, 1) = arr(i, 3)
              [COLOR=#ff0000]n = 1[/COLOR]
              Exit For
           End If
        Next j
        If [COLOR=#ff0000]n < 1[/COLOR] Then
            m = m + 1
            result(m, 1) = arr(i, 1)
            result2(m, 1) = arr(i, 3)
        Else
            [COLOR=#ff0000]n = 0[/COLOR]
        End If
    Next
    [H2].Resize(m, 1) = result
    [I2].Resize(m, 1) = result2
    MsgBox Timer - t
End Sub

siwtom · 13/1/13

dhn46 đã viết:

Nếu chỉ dùng vòng lặp em cũng đóng góp 1 code

Mã:

Sub Gpe()
Dim i As Integer, arr, ArrKq, sArr, s As String
arr = Range("B2:D" & Range("B65536").End(3).Row)
For i = 1 To UBound(arr)
    If InStr(1, s, arr(i, 1)) = 0 Then
        s = s & arr(i, 1) & "-" & arr(i, 3) & ";"
    Else
        If Val(Mid(s, InStr(1, s, arr(i, 1)) + Len(arr(i, 1)) + 1, InStr(Right(s, Len(s) - InStr(1, s, arr(i, 1)) - 1), "-"))) < arr(i, 3) Then
            s = Replace(s, Mid(s, InStr(1, s, arr(i, 1)), InStr(Right(s, Len(s) - InStr(1, s, arr(i, 1))), ";")), arr(i, 1) & "-" & arr(i, 3))
        End If
    End If
Next
ReDim ArrKq(1 To UBound(arr), 1 To 2)


sArr = Split(";" & Left(s, Len(s) - 1), ";")
For i = 1 To UBound(sArr)
    ArrKq(i, 1) = Left(sArr(i), InStr(1, s, "-") - 1)
    ArrKq(i, 2) = Right(sArr(i), Len(sArr(i)) - Len(ArrKq(i, 1)) - 1)
Next
[f2].Resize(UBound(ArrKq), 2) = ArrKq
End Sub

--------------------------------------------
Ngồi rảnh e test Code với 65535 dòng trên cái máy tính cùi mà cho tốc độ khá quá : trên dưới 0.18 (s). Giải thuật này hay quá!

Bạn viết: "Ngồi rảnh e test Code", vậy tôi hiểu là code trên bạn copy từ VBE ra chứ chả nhẽ ngồi gõ lại từng dòng.
Nếu thế thì đúng là ấn tượng đấy. Bạn có thủ thuật nào mà code ở trên chạy được vậy?
Rõ ràng ta có Dim i As Integer, thế mà For i = 1 To UBound(arr) chạy "êm" thì cũng lạ.
Chả nhẽ bạn copy từ VBE ra rồi sửa lại Long thành Integer? Hơi khó tin, vì chả ai mua việc như thế.
Vậy bạn đã thao tác thế nào đây?
--------------
Về tốc độ cũng chưa ấn tượng lắm.
Bạn đo tốc độ code của quanghai chưa?
Chả nhẽ tôi test sai hay máy của tôi có vấn đề. Sự thật là code của quanghai chạy khoảng 60% thời gian code của bạn (cả hai đều 10 lần chạy). Trên máy tôi là khoảng 1 giây - 0,6 giây

to quanghai:
Bạn viết: "Em chứng minh cho anh thấy rằng cách này em xử lý dữ liệu 65000 dòng trong 3 giây là xong"

Tại sao trên máy tôi chỉ mất 0,6 giây? Máy tôi yếu mà 10 năm tuổi rồi.

Quang_Hải · 13/1/13

siwtom đã viết:
to quanghai:
Bạn viết: "Em chứng minh cho anh thấy rằng cách này em xử lý dữ liệu 65000 dòng trong 3 giây là xong"
Tại sao trên máy tôi chỉ mất 0,6 giây? Máy tôi yếu mà 10 năm tuổi rồi.

Thật ra trên máy tính của em chạy chỉ khoảng 1s +, nhưng em đâu có biết máy tính mọi người khác thế nào nên phải tăng lên như thế nghe cho hợp lý. Tính em vẫn thế, nếu khả năng mình làm được 10 chỉ nói là 5 thôi cho an toàn.

dhn46 · 13/1/13

siwtom đã viết:
Bạn viết: "Ngồi rảnh e test Code", vậy tôi hiểu là code trên bạn copy từ VBE ra chứ chả nhẽ ngồi gõ lại từng dòng.
Nếu thế thì đúng là ấn tượng đấy. Bạn có thủ thuật nào mà code ở trên chạy được vậy?
Rõ ràng ta có Dim i As Integer, thế mà For i = 1 To UBound(arr) chạy "êm" thì cũng lạ.
Chả nhẽ bạn copy từ VBE ra rồi sửa lại Long thành Integer? Hơi khó tin, vì chả ai mua việc như thế.
Vậy bạn đã thao tác thế nào đây?
--------------
Về tốc độ cũng chưa ấn tượng lắm.
Bạn đo tốc độ code của quanghai chưa?
Chả nhẽ tôi test sai hay máy của tôi có vấn đề. Sự thật là code của quanghai chạy khoảng 60% thời gian code của bạn (cả hai đều 10 lần chạy). Trên máy tôi là khoảng 1 giây - 0,6 giây

to quanghai:
Bạn viết: "Em chứng minh cho anh thấy rằng cách này em xử lý dữ liệu 65000 dòng trong 3 giây là xong"

Tại sao trên máy tôi chỉ mất 0,6 giây? Máy tôi yếu mà 10 năm tuổi rồi.

Cảm ơn bác SiwTom đã chỉ ra nhưng vấn đề Code dhn46. Dhn46 có 1 số giải thích và sửa đổi + chứng minh như sau:

A - Giải thích:
Thuật toán này dhn46 học được trên GPE và áp dụng tự viết cho bài này. Khi test Code thì dòng dữ liệu 65536 vẫn tồn tại dẫn tới test sai => Sơ suất đáng trách

B - Sửa đổi:
Ngồi voọc lại 1 chút thấy code của dhn46 có 1 chút vấn đề
1 - Đúng như bác Siwtom chỉ ra, i = integer là Sai vậy xin sửa thành Long
2 - Đoạn Code

Mã:

ArrKq(i, 1) = Left(sArr(i), InStr(1, s, "-") - 1)

sửa thành

Mã:

ArrKq(i, 1) = Left(sArr(i), InStr(1, sArr(i), "-") - 1)

C - Chứng minh:
Với các dữ liệu khác nhau và máy khác nhau thì cho các kết quả test khác nhau. Để thống nhất dhn46 đã làm 1 file test với 3 Code: dhn46 - quanghai -quanghai_editSiwtom. Và trên máy cùi bắp của dhn46(celeron2.4, ram 512) thì có kết quả test như File đính kèm => tốc độ dhn46 chỉ bằng 60% Code còn lại
Cảm ơn mọi người và mong nhận được sử chỉ giáo.

thanhlanh · 13/1/13

quanghai1969 đã viết:
Thật ra trên máy tính của em chạy chỉ khoảng 1s +, nhưng em đâu có biết máy tính mọi người khác thế nào nên phải tăng lên như thế nghe cho hợp lý. Tính em vẫn thế, nếu khả năng mình làm được 10 chỉ nói là 5 thôi cho an toàn.

Hi! Một kiểu khiêm tốn lạ.
Biết ngay là không có dic thì phải sàng xê trên mảng mà.
----------------------------
Như đã hứa mình giới thiệu một cách không dùng dic khác, để vọc cho vui thôi chớ không nên dùng nha (mới lạ, chạy chậm, code dài, không dùng được với các ký tự đặc biệt ....)

Mã:

Sub LocMax_Macro4()
    Dim k As Variant, Congty As String
    Dim r As Long, arr(), arrKQ()
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("F1", .Cells(.Rows.Count, "G").End(xlUp)).Offset(1).Clear
        arr = .Range("B2", .Cells(.Rows.Count, "D").End(xlUp)).Value
        ReDim arrKQ(1 To UBound(arr, 1), 1 To 2)
        For r = 1 To UBound(arr, 1)
            If arr(r, 1) <> "" Then
                Congty = CStr(Replace(arr(r, 1), " ", "___"))
                k = GetName(Congty)
                If IsError(k) Then
                    i = i + 1
                    SetName Congty, i
                    arrKQ(i, 1) = Replace(Congty, "___", " ")
                    arrKQ(i, 2) = arr(r, 3)
                Else
                    If k <> Congty Then If arrKQ(k, 2) < arr(r, 3) Then arrKQ(k, 2) = arr(r, 3)    ': arrKQ(k, 1) = Congty
                End If
            End If
        Next
        .Range("F2").Resize(UBound(arrKQ, 1), 2).Value = arrKQ
        .Range("F2:G11").Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlNo
    End With
    For i = 1 To UBound(arrKQ, 1)
        Congty = Replace(arrKQ(i, 1), " ", "___")
        DelName Congty
    Next
End Sub

Các thủ tục, hàm kèm theo:

Mã:

Sub SetName(Name As String, Value)
    Application.ExecuteExcel4Macro "SET.NAME(""" & Name & """," & Value & ")"
End Sub
Function GetName(Name As String)
    GetName = Application.ExecuteExcel4Macro(Name)
End Function
Sub DelName(Name As String)
    Application.ExecuteExcel4Macro "SET.NAME(""" & Name & """)"
End Sub

Các thủ tục, hàm này dùng để tạo, đọc và xóa Name trong VBA (không phải Name trong Excel)
Các Name/biến được tạo theo cách này, nếu chưa có lệnh xóa thì nó sẽ được lưu giữ cho đến khi ta thoát Excel, dùng để lưu gía trị của biến công cộng thì tuyệt vời.

ndu96081631 · 13/1/13

quanghai1969 đã viết:
Em chứng minh cho anh thấy rằng cách này em xử lý dữ liệu 65000 dòng trong 3 giây là xong
Đàn em của anh càng ngày càng bớt dốt rồi mà.
-----------------------
Nếu anh cho rằng Transpose không tốt thì em xin xài code này

Rảnh ngồi xem lại cái (vì tôi KHÔNG TIN cái trong 3 giây ấy tí nào)
Thí nghiệm bằng cách gõ vào cell B2 chữ "Nguyễn 1" rồi kéo fill xuống đến hết (mục đích đếch cho thằng nào trùng) ---> Xong nhấn nút phát xong bao lâu nó ra kết quả
Ẹc... Ẹc...
-----------------
Tất cả những code khác cũng test theo kiểu dữ liệu mới này nhé ---> Nếu không phải bấm Ctrl + Alt + Del thì xin chúc mừng: Máy mạnh

Quang_Hải · 13/1/13

ndu96081631 đã viết:
Rảnh ngồi xem lại cái (vì tôi KHÔNG TIN cái trong 3 giây ấy tí nào)
Thí nghiệm bằng cách gõ vào cell B2 chữ "Nguyễn 1" rồi kéo fill xuống đến hết (mục đích đếch cho thằng nào trùng) ---> Xong nhấn nút phát xong bao lâu nó ra kết quả
Ẹc... Ẹc...
-----------------
Tất cả những code khác cũng test theo kiểu dữ liệu mới này nhé ---> Nếu không phải bấm Ctrl + Alt + Del thì xin chúc mừng: Máy mạnh

Với cách trên thì máy tính của em cũng cho ra kết quả là 3... nhưng không phải 3s mà là 3 phút. Chính xác là 180s+
Cũng với dữ liệu này thì dùng cách .Add thì máy tính em cho ra kết quả trong 1s+
Nhưng mà anh chơi kiểu này cũng ác quá.
Cấu hình CPU 2.5 x 4 RAM 4G

siwtom · 13/1/13

quanghai1969 đã viết:
Thật ra trên máy tính của em chạy chỉ khoảng 1s +, nhưng em đâu có biết máy tính mọi người khác thế nào nên phải tăng lên như thế nghe cho hợp lý. Tính em vẫn thế, nếu khả năng mình làm được 10 chỉ nói là 5 thôi cho an toàn.

À, hóa ra sửa đổi kết quả, giả mạo chứng từ văn bản ...

Tôi không ngạc nhiên cái chuyện 3 giây - 0,6 giây, có thể là 3 ngày - 0,6 ngày. Cái này nó phụ thuộc vào dữ liệu đầu vào và vào máy.

Cái tôi ngạc nhiên là tỉ lệ. Bởi nếu cùng dữ liệu đầu vào như thế như thế mà ở máy 10 tuổi của tôi lại chạy nhanh gấp 5 lần thì tôi thấy bất ngờ quá.

thanhlanh · 13/1/13

ndu96081631 đã viết:
Rảnh ngồi xem lại cái (vì tôi KHÔNG TIN cái trong 3 giây ấy tí nào)
Thí nghiệm bằng cách gõ vào cell B2 chữ "Nguyễn 1" rồi kéo fill xuống đến hết (mục đích đếch cho thằng nào trùng) ---> Xong nhấn nút phát xong bao lâu nó ra kết quả
Ẹc... Ẹc...
-----------------
Tất cả những code khác cũng test theo kiểu dữ liệu mới này nhé ---> Nếu không phải bấm Ctrl + Alt + Del thì xin chúc mừng: Máy mạnh

Mình test dữ liệu của Hải (64800 dòng) không cho thằng nào trùng, bằng code mình (có dùng dic) 15 lần thì hết 12 lần là 2.422s nhưng máy mình trung bình chớ không mạnh (E5400 2.7Ghz, Ram 2G).
Nếu hàm Transpose làm chậm thì cũng dùng có một lần, không sợ. Còn ndu nói hàm Transpose có thể gây lỗi thì ở trường hợp nào, chớ ở đây mảng mới luôn "ngắn" hơn hoặc bằng mảng cũ làm sao lỗi?

ndu96081631 · 13/1/13

thanhlanh đã viết:
Mình test dữ liệu của Hải (64800 dòng) không cho thằng nào trùng, bằng code mình (có dùng dic) 15 lần thì hết 12 lần là 2.422s nhưng máy mình trung bình chớ không mạnh (E5400 2.7Ghz, Ram 2G).

Ý em là muốn anh và các bạn khác thử code không dùng Dic với loại dữ liệu 65000 dòng không trùng xem nó chạy nỗi không
Bởi vậy mới nói: Dictionary là thứ chuyên trị về Unique, chúng ta khỏi mất công nghiên cứu lòng vòng chi cho mệt (trừ phi anh siwtom nghĩ ra được giải thuật nào khác)
Em nói thêm: Ngay cả khi dùng Dictionary nhưng cố tình không chơi phương thức Exists mà lại dùng Item property thì vẫn chậm hơn
Tóm lại: Dùng đúng công cụ, đúng cách luôn cho kết quả tốt nhất

thanhlanh đã viết:
Còn ndu nói hàm Transpose có thể gây lỗi thì ở trường hợp nào, chớ ở đây mảng mới luôn "ngắn" hơn hoặc bằng mảng cũ làm sao lỗi?

Trên diễn đàn mình đây thôi anh à, trước đây đã từng có vài lần bị lỗi với Transpose nên từ đó trở đi em không dùng nữa (thà rằng tự viết lấy hàm xoay mảng 90 độ còn hơn)... Với lại, ta hoàn toàn có thể xây dựng được mảng 2 chiều thì mắc mớ gì phải dùng mảng 1 chiều rồi lại phải mất công Transpose?

ndu96081631 · 13/1/13

quanghai1969 đã viết:
Với cách trên thì máy tính của em cũng cho ra kết quả là 3... nhưng không phải 3s mà là 3 phút. Chính xác là 180s+
Cũng với dữ liệu này thì dùng cách .Add thì máy tính em cho ra kết quả trong 1s+
Nhưng mà anh chơi kiểu này cũng ác quá.
Cấu hình CPU 2.5 x 4 RAM 4G

Cũng kiên nhẫn ghê!
Tôi chưa khi nào phải đợi code chạy quá 20s ----> Vốn nóng tính và ưa thích tốc độ nên.. Ctrl + Alt + Del cho rồi
Ẹc... ẹc...

dhn46 · 13/1/13

ndu96081631 đã viết:
Ý em là muốn anh và các bạn khác thử code không dùng Dic với loại dữ liệu 65000 dòng không trùng xem nó chạy nỗi không
Bởi vậy mới nói: Dictionary là thứ chuyên trị về Unique, chúng ta khỏi mất công nghiên cứu lòng vòng chi cho mệt (trừ phi anh siwtom nghĩ ra được giải thuật nào khác)
Em nói thêm: Ngay cả khi dùng Dictionary nhưng cố tình không chơi phương thức Exists mà lại dùng Item property thì vẫn chậm hơn
Tóm lại: Dùng đúng công cụ, đúng cách luôn cho kết quả tốt nhất

Thầy nói "Chuẩn" quá. đúng là với cái máy tính cùi như của em thì "Không thể Test" (đợi không nổi alt + ctrl + del luôn)với khối dữ liệu không trùng lớn khi không dùng Dic. Nhưng qua bài này e cũng thấy thú vị vì có nhiều cách, tư duy hay, nhưng em vẫn thắc mắc không hiểu thầy SiwTom test trên máy thầy ấy lại có kết quả lạ (máy tính em đang dùng chắc cũng 10 năm).

siwtom · 13/1/13

ndu96081631 đã viết:
Ý em là muốn anh và các bạn khác thử code không dùng Dic với loại dữ liệu 65000 dòng không trùng xem nó chạy nỗi không
Bởi vậy mới nói: Dictionary là thứ chuyên trị về Unique, chúng ta khỏi mất công nghiên cứu lòng vòng chi cho mệt (trừ phi anh siwtom nghĩ ra được giải thuật nào khác)
Em nói thêm: Ngay cả khi dùng Dictionary nhưng cố tình không chơi phương thức Exists mà lại dùng Item property thì vẫn chậm hơn
Tóm lại: Dùng đúng công cụ, đúng cách luôn cho kết quả tốt nhất

1. code chậm là đương nhiên. Ta nhìn vòng lặp thứ hai trong code của Hải. Nếu các dữ liệu không không trùng nhau thì Exit For sẽ không bao giờ sẩy ra, tức luôn có m vòng lặp. Mà m thì tăng liên tục từ 1 tới 64800

2. Tuấn chắc hiểu là không ai muốn tìm "công cụ" khác cả. Mọi người không dùng DIC, Exists, Add bởi đây là "bài đố" và người ra bài không cho phép dùng DIC, Exists, Add.

3. Có thể kiểm tra "trùng" nhưng không dùng cách chạy hết các phần tử của mảng kết quả như Hải đã làm trong FOR thứ hai. Tuy nhiên tôi cho rằng không thể nhanh hơn phương thức Exists của Dic được. Vì sao? Vì nói cho cùng thì thuật toán mình cần dùng cũng là một trong những thuật toán đã có trong lập trình nói chung.Có nhiều sách hoặc trang trên mạng chỉ nói về các thuật toán. Nhiều lắm.
Vậy nếu ta dùng một thuật toán được biết thì chả nhẽ Microsoft lại không biết? Khả năng cao hơn rất nhiều là "nó" còn biết những thuật toán mà mình không biết.

4. Tuấn để ý là tôi không tham gia dự thi. Vì tôi không thích lắm cái trò: đố làm được "cái này" mà không dùng DIC, không dùng Macro4, không dùng ...
Vì tôi biết là có đưa ra cách giải quyết thì nó cũng chỉ được dùng 1 lần trên "bàn nhậu" khi thách đố nhau thôi. Code "đó" sẽ không bao giờ được dùng trong thực tế.

Tôi sửa code của Hải trên nguyên tắc: "nếu đã viết code như thế thì cũng nên viết gọn hơn như thế này thế này".

Code của Hải chỉ là cái cớ để mình hướng dẫn cách phân tích và rút gọn code trong lập trình. Nó không phải là bài "dự thi" của siwtom, vì siwtom không dự thi. Vì siwtom không có ý định viết code chạy nhanh như DIC mà lại thay thế DIC.

ndu96081631 · 13/1/13

siwtom đã viết:
4. Tuấn để ý là tôi không tham gia dự thi. Vì tôi không thích lắm cái trò: đố làm được "cái này" mà không dùng DIC, không dùng Macro4, không dùng ...
Vì tôi biết là có đưa ra cách giải quyết thì nó cũng chỉ được dùng 1 lần trên "bàn nhậu" khi thách đố nhau thôi. Code "đó" sẽ không bao giờ được dùng trong thực tế.
.

Cái em quan tâm ở đây là: thằng Dictionary nó dùng thuật toán gì mà có thể Check Exists ngon lành vậy
Lúc đầu em nghĩ đến hàm StrPtr chuyển String thành Long và lấy giá trị Long này thiết lập vị trí trong mảng, đáng tiếc là thí nghiệm không thành công
Anh biết có hàm nào chuyển String thành Long không? Điều kiện là String khác nhau thì giá trị Long nhận được cũng phải khác nhau (đồng thời giá trị Long lớn nhất cũng không được lớn hơn 6 chữ số)
Nếu được như vậy thì giải pháp không còn là vấn đề

thanhlanh · 14/1/13

ndu96081631 đã viết:
Em nói thêm: Ngay cả khi dùng Dictionary nhưng cố tình không chơi phương thức Exists mà lại dùng Item property thì vẫn chậm hơn
Tóm lại: Dùng đúng công cụ, đúng cách luôn cho kết quả tốt nhất

Mình phải kiểm chứng, chạy hai code này:

Mã:

Sub LocMax() ' Cua Lanh
    Dim t As Double
    t = Timer
    Dim r As Long, Arr(), Dic As Object
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("F1", .Cells(.Rows.Count - 1, "G").End(xlUp)).Offset(1).Clear
        Arr = .Range("B2", .Cells(.Rows.Count, "D").End(xlUp)).Value
        Set Dic = CreateObject("Scripting.Dictionary")
        For r = 1 To UBound(Arr, 1)
            If Dic.Item(Arr(r, 1)) = "" Then Dic.Item(Arr(r, 1)) = Arr(r, 3)
            If Arr(r, 3) > Dic.Item(Arr(r, 1)) Then Dic.Item(Arr(r, 1)) = Arr(r, 3)
        Next
        .Range("F2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)
        .Range("G2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
        '.Range("F2:G11").Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlNo
    End With
    Set Dic = Nothing
    ThisWorkbook.Worksheets("Sheet1").Range("N1000").End(xlUp).Offset(1) = Timer - t
End Sub

và

Mã:

Sub ConsolMax()    ' Cua Anh Bate
    Dim t As Double
    t = Timer
    Dim Dic As Object, Arr(), I As Long, K As Long, Tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
    For I = 1 To UBound(Arr, 1)
        Tem = Arr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, Arr(I, 3)
        Else
            If Dic.Item(Tem) < Arr(I, 3) Then Dic.Item(Tem) = Arr(I, 3)
        End If
    Next I
    With Application.WorksheetFunction
        [F2].Resize(K).Value = .Transpose(Dic.Keys)
        [G2].Resize(K).Value = .Transpose(Dic.Items)
    End With
    Set Dic = Nothing
    ThisWorkbook.Worksheets("Sheet1").Range("O1000").End(xlUp).Offset(1) = Timer - t
End Sub

Làm hai cái nút bấm và chạy em này một cái, em kia một cái (coi như công bằng về trình trạng sức khỏe của máy)

Cách 1: Không dùng .Exists và .add, có dùng Transpose
-----2: Có ------------------------ có -----------
Kết quả: Không dùng .Exists và .add thì vẫn chạy nhanh hơn từ 2-4,5% ? (hay là cách 2 có thêm công đoạn gắn vào biến Tem làm chậm hơn ?)

siwtom · 14/1/13

ndu96081631 đã viết:
Cái em quan tâm ở đây là: thằng Dictionary nó dùng thuật toán gì mà có thể Check Exists ngon lành vậy
Lúc đầu em nghĩ đến hàm StrPtr chuyển String thành Long và lấy giá trị Long này thiết lập vị trí trong mảng, đáng tiếc là thí nghiệm không thành công
Anh biết có hàm nào chuyển String thành Long không? Điều kiện là String khác nhau thì giá trị Long nhận được cũng phải khác nhau (đồng thời giá trị Long lớn nhất cũng không được lớn hơn 6 chữ số)
Nếu được như vậy thì giải pháp không còn là vấn đề

Tôi cũng chịu không biết nó làm thế nào.

Nhưng ta có thể thử cải tiến code của Hải.
Tôi nghĩ theo hướng thế này. Song song với mảng mà ta muốn thêm phần tử vào thì ta tạo ra 1 mảng cùng kích thước mà chứa chỉ số của các phần tử ở mảng "kia" nếu nó được sắp xếp tăng dần (giảm dần). Vd. ta có mảng Arr = 2, 8, 3, 1 thì ArrIndex = 4, 1, 3, 2
Ta định thêm phần tử "5" vào Arr. Để kiểm tra "5" đã tồn tại chưa thì:
Hiện thời ArrIndex có chỉ số dưới là 1, trên là 4 --> tính k = (duoi + tren) \ 2 = 2
Ta thấy Arr(ArrIndex(2)) = 2 < 5, vậy nếu 5 tồn tại thì 5 phải có chỉ số (trong Arr) nằm trong khoảng [2+1=3;4] --> tính k = (duoi + tren) \ 2 = (3 + 4) \ 2 = 3
Ta thấy Arr(ArrIndex(3)) = 3 < 5, vậy nếu 5 tồn tại thì 5 phải có chỉ số (trong Arr) nằm trong khoảng [3+1=4;4] --> tính k = (duoi + tren) \ 2 = (4 + 4) \ 2 = 4
Ta thấy Arr(ArrIndex(4)) = 8 <> 5.
Vậy 5 không tồn tại trong Arr
--------
Giả sử ta kiểm tra phần tử 1 (đã có trong Arr ở vị trí cuối cùng = 4)
k = (duoi + tren) \ 2 = 2
Ta thấy Arr(ArrIndex(2)) = 2 > 1, vậy nếu 1 tồn tại thì 1 phải có chỉ số (trong Arr) nằm trong khoảng [1, 2 - 1 = 1] --> tính k = (duoi + tren) \ 2 = (1 + 1) \ 2 = 1
Ta thấy Arr(ArrIndex(1)) = 1 => 1 tồn tại trong Arr (có chỉ số là ArrIndex(1) = 4)
-------------
Ví dụ để kiểm tra xem ô B32770 (i = 32770) có trong mảng hay không (m = 32768 = 2^15) thì chỉ cần 15 - 16 lần kiểm tra thay vì 32768 lần kiểm tra trong FOR.
---------------
Thuật toán nôm na là thế này: Để tìm một phần tử trong mảng có sắp xếp thì: Ta chia mảng thành 2 nửa bằng cách lấy phần tử "ở giữa". Nếu phần tử này "bằng" phần tử cần tìm thì ta tìm được và kết thúc. Nếu phần tử này < phần tử cần tìm thì trong bước tiếp theo ta sẽ tìm trong "nửa trên", còn nếu nó > phần tử cần tìm thì trong bước tiếp theo ta tìm trong "nửa dưới". Do "khoảng tìm kiếm" qua mỗi bước giảm đi một nửa nên ta có hữu hạn bước tìm kiếm để xác định phần tử có tồn tại hay không.

Tất nhiên đồng thời có thể trả về Index: nếu phần tử đã có trong mảng với chỉ số là n thì trả về index = n. Nếu phần tử chưa có trong mảng thì cũng xác định được n thỏa đk: phần tử thứ n của mảng < phần tử cần kiểm tra AND phần tử cần kiểm tra < phần tử (n + 1) của mảng. Lúc này vd. trả về Index = n + 1. Hàm ý là nếu thêm phần tử này vào mảng Arr (ở cuối) thì chỉ số của nó trong Arr (là m) phải ghi vào màng ArrIndex ở vị trị Index = n + 1. Tức phải mở rộng ArrIndex thêm 1 --> các phần tử từ Index dịch về cuối 1 "ô" --> ghi chỉ sổ của phần tử đã thêm, tức m, vào vị trí Index.
-------------
Tôi cũng đang nghĩ thử làm chơi một class cho việc này, dùng tree. Nếu có thời gian và hứng thì sẽ nghiên cứu.

siwtom · 14/1/13

Như đã hứa tôi viết vội một code để test cho trường hợp ~ 65000 dòng không trùng nhau từng đôi một. Như Hải nói thì code không dùng DIC mà Hải đưa ra chạy mất 180 s.

quanghai1969 đã viết:
Với cách trên thì máy tính của em cũng cho ra kết quả là 3... nhưng không phải 3s mà là 3 phút. Chính xác là 180s+
Cũng với dữ liệu này thì dùng cách .Add thì máy tính em cho ra kết quả trong 1s+
Nhưng mà anh chơi kiểu này cũng ác quá.

Tôi thử cải tiến để giảm thời gian.
Không dám nhờ Tuấn test hộ vì

Tôi chưa khi nào phải đợi code chạy quá 20s ----> Vốn nóng tính và ưa thích tốc độ nên.. Ctrl + Alt + Del cho rồi

Mà Hải lại kiên nhẫn nên nhờ Hải test hộ - vì tôi chỉ test vài lần xem code chạy có lỗi hay không mà thôi.
Hải hãy test và thông báo kết quả. Đừng sợ, tôi không "ác" như "tay" Tuấn đâu.

Có 2 ví dụ: unique lấy max (min tương tự) và unique lấy tổng.

Chuyên đề Bài tập VBA

/(hông là gì!

Thành viên gạo cội

Thành viên gạo cội

File đính kèm

Hướng tới tương lai

Thành viên gắn bó

Thành viên gắn bó

Thành viên gạo cội

Hướng tới tương lai

File đính kèm

Thành viên tích cực

Huyền thoại GPE

Thành viên gạo cội

Thành viên gắn bó

Thành viên tích cực

Huyền thoại GPE

Huyền thoại GPE

Hướng tới tương lai

Thành viên gắn bó

Huyền thoại GPE

Thành viên tích cực

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

Facebook

Group