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!

ndu96081631 · 11/1/13

Muốn thì thì nghiệm (dùng Item Property)

Mã:

Sub Test()
  Dim Dic As Object
  Set Dic = CreateObject("Scripting.Dictionary")
  Dic.Add "a", "aa"
  Dic.Add "b", "bb"
  Dic.Add "c", "cc"
  MsgBox TypeName(Dic.Item("[COLOR=#ff0000]d[/COLOR]"))
End Sub

Kiểm tra cái chưa có trong Dic xem nó ra cái gì?

dhn46 · 11/1/13

Mượn Code bác Bate em nộp bài tiếp

Mã:

Sub a()
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 IsNull(Dic.Item(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(Dic.Count).Value = .Transpose(Dic.keys)
[G2].Resize(Dic.Count).Value = .Transpose(Dic.Items)
End With
Set Dic = Nothing
End Sub

thanhlanh · 11/1/13

Mod xóa giùm bài này, do mạng trục trặc bấm nhầm hai lần.

thanhlanh · 11/1/13

dhn46 đã viết:

Mượn Code bác Bate em nộp bài tiếp

Mã:

Sub a()
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 IsNull(Dic.Item(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(Dic.Count).Value = .Transpose(Dic.keys)
[G2].Resize(Dic.Count).Value = .Transpose(Dic.Items)
End With
Set Dic = Nothing
End Sub

Theo yêu cầu của mình thì Bạn đã đạt. Cảm ơn!
Bây giờ mình không muốn cho dùng cả .Exits và .Add của Dictionary luôn. Các bạn thử xem!

thanhlanh · 11/1/13

quanghai1969 đã viết:

Mình nói rồi chẳng có gì khó cả. Nếu khó quá thì bỏ chạy vậy thôi
Mượn code của anh Bate xài

PHP:

Sub vuivuivui()
Dim Arr(), I As Long, Tem As String
Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
   With CreateObject("Scripting.Dictionary")
      For I = 1 To UBound(Arr, 1)
          Tem = Arr(I, 1)
          If Error = 0 Then
              Dic.Add Tem, Arr(I, 3)
          Else
              If .Item(Tem) < Arr(I, 3) Then .Item(Tem) = Arr(I, 3)
          End If
      Next I
      [F2].Resize(.Count).Value = Application.Transpose(.Keys)
      [G2].Resize(.Count).Value = Application.Transpose(.Items)
   End With
End Sub

Không được chơi vs Error nha!

Quang_Hải · 11/1/13

Không cho xài Error thì thôi không xài. Đã nói là không gì làm khó được mà

PHP:

Sub vuivui()
Dim Arr(), i As Long, tem As String
Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
   With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Arr, 1)
         tem = Arr(i, 1)
         If IsEmpty(.Item(tem)) Then
            .Item(tem) = Arr(i, 3)
         Else
            If .Item(tem) < Arr(i, 3) Then .Item(tem) = Arr(i, 3)
         End If
      Next i
      [F2].Resize(.Count).Value = Application.Transpose(.Keys)
      [G2].Resize(.Count).Value = Application.Transpose(.Items)
   End With
End Sub

thanhlanh · 11/1/13

quanghai1969 đã viết:

Không cho xài Error thì thôi không xài. Đã nói là không gì làm khó được mà

PHP:

Sub vuivui()
Dim Arr(), i As Long, tem As String
Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
   With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Arr, 1)
         tem = Arr(i, 1)
         If IsEmpty(.Item(tem)) Then
            .Item(tem) = Arr(i, 3)
         Else
            If .Item(tem) < Arr(i, 3) Then .Item(tem) = Arr(i, 3)
         End If
      Next i
      [F2].Resize(.Count).Value = Application.Transpose(.Keys)
      [G2].Resize(.Count).Value = Application.Transpose(.Items)
   End With
End Sub

Ok!
Còn đây là code của mình:

Mã:

Sub LocMax()
    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
End Sub

Qua bài này mình muốn thực hành cùng các bạn để hiểu sâu hơn về Dictionary và vận dụng, nếu cần:
- Khi gán giá trị cho một Item của key chưa tồn tại thì Dictionary sẽ tự tạo một Key và một Item mới
For r = 1 To UBound(arr, 1)
dic.Item(arr(r, 1)) = arr(r, 3)
- Khi truy cập một Item của Key chưa tồn tại thì Dictionary cũng sẽ tự tạo một Key và một Item mới (rỗng).
For r = 1 To UBound(arr, 1)
If dic.Item(arr(r, 1)) = "" Then hoặc gán: i = dic.Item(arr(r, 1))

Quang_Hải · 11/1/13

Đã mần thì mần thêm cái anh Remove luôn

PHP:

Sub Key_Remove()
Dim arr(), i As Long, tem As String
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
   With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(arr, 1)
         tem = arr(i, 1)
         If Not IsEmpty(.Item(tem)) Then
            If .Item(tem) < arr(i, 3) Then
               .Remove tem
               .Item(tem) = arr(i, 3)
            End If
         Else
            .Item(tem) = arr(i, 3)
         End If
      Next i
      [F2].Resize(.Count).Value = Application.Transpose(.Keys)
      [G2].Resize(.Count).Value = Application.Transpose(.Items)
   End With
End Sub

Bài này chủ yếu là mổ xẽ các phương thức và thuộc tính của Dictionary thôi. Tạm thời không chú ý đến những yếu tố khác

ndu96081631 · 11/1/13

thanhlanh đã viết:
Ok!
Còn đây là code của mình:

Mã:

Sub LocMax() 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 End Sub

Qua bài này mình muốn thực hành cùng các bạn để hiểu sâu hơn về Dictionary và vận dụng, nếu cần:
- Khi gán giá trị cho một Item của key chưa tồn tại thì Dictionary sẽ tự tạo một Key và một Item mới
For r = 1 To UBound(arr, 1)
dic.Item(arr(r, 1)) = ""

- Khi truy cập một Item của Key chưa tồn tại thì Dictionary cũng sẽ tự tạo một Key và một Item mới.
For r = 1 To UBound(arr, 1)
dic.Item(arr(r, 1)) = arr(r, 3)

Bài này mà chơi WorksheetFunction.Transpose là vô cùng dở (ẹc) luôn ---> Sẽ bị lỗi nghiêm trọng đối với dữ liệu lớn
Em đề nghị kiểu khác: Gán Range vào mảng ---> Thay đổi giá trị mảng ---> gán mảng ngược lại

Mã:

Sub ConsolMAX()
  Dim aData, sTmp As String
  Dim lR As Long, n As Long, lMax As Double
  aData = Sheet1.Range("B2:D60000").Value
  With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For lR = 1 To UBound(aData)
      sTmp = CStr(aData(lR, 1))
      If Len(sTmp) Then
        If TypeName(.Item(sTmp)) = "Empty" Then
          n = n + 1
          .Item(sTmp) = n
          aData(n, 1) = sTmp
          aData(n, 2) = aData(lR, 3)
        Else
          lMax = aData(lR, 3)
          If lMax > aData(.Item(sTmp), 2) Then aData(.Item(sTmp), 2) = lMax
        End If
      End If
    Next
  End With
  If n Then
    With Sheet1.Range("F2:G60000")
      .ClearContents
      .Resize(n, 2).Value = aData
    End With
  End If
End Sub

60000 dòng ra kết quả trong vòng 0.5 giây
Ngoài ra code anh chưa tính vụ dữ liệu rổng nha!

thanhlanh · 11/1/13

Cảm ơn! nhưng mình chỉ chú trọng vào thực hành tính chất của Dic

ndu96081631 · 11/1/13

thanhlanh đã viết:
Cảm ơn! nhưng mình chỉ chú trọng vào thực hành tính chất của Dic

Vâng! Thì em cũng vậy
Nhưng mà bài này em thấy rất thực tế (nếu không muốn xài PivotTable) nên đã làm thì làm.. tới bến luôn chứ anh! (để ứng dụng)
Ẹc... Ẹc...

Ba Tê · 11/1/13

ndu96081631 đã viết:
Bài này mà chơi WorksheetFunction.Transpose là vô cùng dở (ẹc) luôn ---> Sẽ bị lỗi nghiêm trọng đối với dữ liệu lớn
Em đề nghị kiểu khác: Gán Range vào mảng ---> Thay đổi giá trị mảng ---> gán mảng ngược lại

Mã:

Sub ConsolMAX() Dim aData, sTmp As String Dim lR As Long, n As Long, lMax As Double aData = Sheet1.Range("B2:D60000").Value With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For lR = 1 To UBound(aData) sTmp = CStr(aData(lR, 1)) If Len(sTmp) Then If TypeName(.Item(sTmp)) = "Empty" Then n = n + 1 .Item(sTmp) = n aData(n, 1) = sTmp aData(n, 2) = aData(lR, 3) Else lMax = aData(lR, 3) If lMax > aData(.Item(sTmp), 2) Then aData(.Item(sTmp), 2) = lMax End If End If Next End With If n Then With Sheet1.Range("F2:G60000") .ClearContents .Resize(n, 2).Value = aData End With End If End Sub

60000 dòng ra kết quả trong vòng 0.5 giây
Ngoài ra code anh chưa tính vụ dữ liệu rổng nha!

Bài này với "luật lệ" của bài này thì có gì "phạm quy" hông ta?

thanhlanh đã viết:
Cũng được nhưng chưa đúng ý đồ của mình lắm. Thôi thêm một ràng buộc nữa: mảng chỉ được phép xử dụng (gán, đọc) một lần

mảng aData hình như bị đọc và gán lại hơn một lần!
Gán:

sTmp = CStr(aData(lR, 1))

Cái này hình như là đọc:

sTmp = CStr(aData(lR, 1))

Cái này hình như là gán lại:

aData(n, 1) = sTmp aData(n, 2) = aData(lR, 3)

Híc!
Hay lại say nữa rồi??!!..
Éc! Éc...

ndu96081631 · 12/1/13

Ba Tê đã viết:
Bài này với "luật lệ" của bài này thì có gì "phạm quy" hông ta?

mảng aData hình như bị đọc và gán lại hơn một lần!
Gán:

Cái này hình như là đọc:

Cái này hình như là gán lại:

Híc!
Hay lại say nữa rồi??!!..
Éc! Éc...

Cũng như anh thanhlanh đã nói

thanhlanh đã viết:
mình chỉ chú trọng vào thực hành tính chất của Dic

nên em chỉ quan tâm đến giải thuật xử lý trong Dictionary thôi, còn mảng thế nào không quan trọng. Thậm chí nên thêm 1 Array kết quả nữa sẽ tường minh hơn

thanhlanh · 12/1/13

Ba Tê đã viết:
Bài này với "luật lệ" của bài này thì có gì "phạm quy" hông ta?

mảng aData hình như bị đọc và gán lại hơn một lần!
Gán:

Cái này hình như là đọc:

Cái này hình như là gán lại:

Híc!
Hay lại say nữa rồi??!!..
Éc! Éc...

Mình đã thấy như vậy rồi, nhưng lúc đó mình đã công bố đáp án nên không ý kiến gì.

Với bài tập này, mình muốn thay đổi tư duy xử dụng Dictionary, chớ lâu nay mỗi khi tìm duy nhất là buộc phải dùng phương thức Exists. Ở đây ta có thêm một lựa chọn là có thể không dùng Exists và add mà vẫn giải quyết được. Chẳng hạn với yêu cầu đơn giản là lọc một danh sách có trùng thành một danh sách không trùng, không quan tâm giá trị khác thì chẳng cần Exists làm gì.

Bài của ndu được xem như một bài phản biện, góp ý chớ không phải bài thi ...

Sắp tới, cũng yêu cầu này mình cắt luôn không cho sài Dictionary, Collection nhưng cũng không phải sàng xê trên mảng để lọc hay tìm danh sách duy nhất (tất nhiên phải dùng mảng để "chứa dữ liệu" và trích xuất các giá trị khác). Nhưng nếu làm thì cũng chỉ là cho vui thôi nên sẽ chuyển bài qua mục đố vui. Các bạn nghiên cứu thử xem.

dhn46 · 12/1/13

Các thầy ra những bài tâph như thế này quả là bổ ích học được nhiều và hiểu sâu hơn VBA. Mong rằng các thầy ra nhiều nhiều bài nữa để bậc vỡ lòng tụi em còn mần Code (Các thầy có thể ra bài buổi tối hoặc kết thúc đáp án vào buổi tối được không vì ban ngày có thể tụi em không online được - Híc)

thanhlanh đã viết:
Sắp tới, cũng yêu cầu này mình cắt luôn không cho sài Dictionary, Collection nhưng cũng không phải sàng xê trên mảng để lọc hay tìm danh sách duy nhất (tất nhiên phải dùng mảng để "chứa dữ liệu" và trích xuất các giá trị khác). Nhưng nếu làm thì cũng chỉ là cho vui thôi nên sẽ chuyển bài qua mục đố vui. Các bạn nghiên cứu thử xem.

Về vấn đề trích lọc danh sách duy nhất không dùng Dic thì cũng đã được đề cập (Dhn46 nhớ không lầm thì trong Topic của bác TrungChinh về tách thửa đất) và phương pháp rất tối ưu của bác Cò đó là dùng Instr(...)

Chúc các thầy dồi dào sức khỏe và tích cực ra bài nữa.

ndu96081631 · 12/1/13

thanhlanh đã viết:
Mình đã thấy như vậy rồi, nhưng lúc đó mình đã công bố đáp án nên không ý kiến gì.

Với bài tập này, mình muốn thay đổi tư duy xử dụng Dictionary, chớ lâu nay mỗi khi tìm duy nhất là buộc phải dùng phương thức Exists. Ở đây ta có thêm một lựa chọn là có thể không dùng Exists và add mà vẫn giải quyết được. Chẳng hạn với yêu cầu đơn giản là lọc một danh sách có trùng thành một danh sách không trùng, không quan tâm giá trị khác thì chẳng cần Exists làm gì.

Bài của ndu được xem như một bài phản biện, góp ý chớ không phải bài thi ...

Sắp tới, cũng yêu cầu này mình cắt luôn không cho sài Dictionary, Collection nhưng cũng không phải sàng xê trên mảng để lọc hay tìm danh sách duy nhất (tất nhiên phải dùng mảng để "chứa dữ liệu" và trích xuất các giá trị khác). Nhưng nếu làm thì cũng chỉ là cho vui thôi nên sẽ chuyển bài qua mục đố vui. Các bạn nghiên cứu thử xem.

Tản mạn chút (rồi bị del cũng.. chịu)
Kiến thức về Dictionary, VBScript.RegExp, Array và 1 vài thứ khác tuy đã có nhiều trên diễn đàn trước khi mình tham gia, nhưng mình nhớ không lầm thì mình mới chính là người đầu tiên đưa những kiến thức đó tiếp cận với "giới bình dân"
Những tưởng đó là tuyệt chiêu của riêng, ai ngờ giờ đây bao nhiêu thành viên vận dụng nó còn "bén" hơn cả mình ---> Đến nỗi nhìn vào code của mọi người mình còn phải "lác mắt"
Híc... vậy là đến cuối cùng, mình.. đếch còn gì rồi
-----------------------------
Anh thanhlanh sao không đưa yêu cầu mới mà anh vừa nói lên đi (em cũng thấy tò mò)

thanhlanh · 12/1/13

dhn46 đã viết:
Các thầy ra những bài tâph như thế này quả là bổ ích học được nhiều và hiểu sâu hơn VBA. Mong rằng các thầy ra nhiều nhiều bài nữa để bậc vỡ lòng tụi em còn mần Code (Các thầy có thể ra bài buổi tối hoặc kết thúc đáp án vào buổi tối được không vì ban ngày có thể tụi em không online được - Híc)

Về vấn đề trích lọc danh sách duy nhất không dùng Dic thì cũng đã được đề cập (Dhn46 nhớ không lầm thì trong Topic của bác TrungChinh về tách thửa đất) và phương pháp rất tối ưu của bác Cò đó là dùng Instr(...)

Chúc các thầy dồi dào sức khỏe và tích cực ra bài nữa.

Nhưng nếu không dùng Dictionary hoặc Collection thì chắc phải sàng qua sàng lại trên mảng để tìm, mình không muốn vậy, thế nên mới gọi là vui chớ!

thanhlanh · 12/1/13

ndu96081631 đã viết:
Tản mạn chút (rồi bị del cũng.. chịu)
Kiến thức về Dictionary, VBScript.RegExp, Array và 1 vài thứ khác tuy đã có nhiều trên diễn đàn trước khi mình tham gia, nhưng mình nhớ không lầm thì mình mới chính là người đầu tiên đưa những kiến thức đó tiếp cận với "giới bình dân"
Những tưởng đó là tuyệt chiêu của riêng, ai ngờ giờ đây bao nhiêu thành viên vận dụng nó còn "bén" hơn cả mình ---> Đến nỗi nhìn vào code của mọi người mình còn phải "lác mắt"
Híc... vậy là đến cuối cùng, mình.. đếch còn gì rồi
-----------------------------
Anh thanhlanh sao không đưa yêu cầu mới mà anh vừa nói lên đi (em cũng thấy tò mò)

Hi hi đừng tự giày vò bản thân như thế, mình có đi tên lửa cũng chẳng bao giờ bằng ndu, vì cái chỉ số IQ gì đó nó quyết định.

Yêu cầu mới của mình cũng là giải bài này bằng mảng kết hợp Macro4 chơi nhưng cũng chưa xong, khi nào làm được thì sẽ giới thiệu, còn không được thì thôi chớ đừng ném đá nha!

Quang_Hải · 12/1/13

thanhlanh đã viết:
Hi hi đừng tự giày vò bản thân như thế, mình có đi tên lửa cũng chẳng bao giờ bằng ndu, vì cái chỉ số IQ gì đó nó quyết định.

Yêu cầu mới của mình cũng là giải bài này bằng mảng kết hợp Macro4 chơi nhưng cũng chưa xong, khi nào làm được thì sẽ giới thiệu, còn không được thì thôi chớ đừng ném đá nha!

Không cho xài Dic để lấy dữ liệu duy nhất thì xài mảng cũng xơi được. Cái macro4 gì đó mình không biết xài nên xử kiểu này thấy cũng đơn giản. Mình thuộc dạng liều mạng mà. Híc.

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
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
ReDim result(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
   For j = 1 To UBound(result)
      If arr(i, 1) = result(j, 1) Then
         If result(j, 2) < arr(i, 3) Then result(j, 2) = 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):      result(m, 2) = arr(i, 3)
   End If
Next
[H2].Resize(m, 2) = result
End Sub

ndu96081631 · 12/1/13

quanghai1969 đã viết:
Không cho xài Dic để lấy dữ liệu duy nhất thì xài mảng cũng xơi được. Cái macro4 gì đó mình không biết xài nên xử kiểu này thấy cũng đơn giản. Mình thuộc dạng liều mạng mà. Híc.

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 arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value ReDim result(1 To UBound(arr), 1 To 2) For i = 1 To UBound(arr) For j = 1 To UBound(result) If arr(i, 1) = result(j, 1) Then If result(j, 2) < arr(i, 3) Then result(j, 2) = 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): result(m, 2) = arr(i, 3) End If Next [H2].Resize(m, 2) = result End Sub

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...

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

/(hông là gì!

Huyền thoại GPE

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

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

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

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

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

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

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

Huyền thoại GPE

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

Huyền thoại GPE

Cạo Rồi Khỏi Gội

Huyền thoại GPE

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

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

Huyền thoại GPE

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

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

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

Huyền thoại GPE

Facebook

Group