Các câu hỏi về mảng trong VBA (Array) (1 người xem)

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

Hoàng Nhật Phương · 30/10/18

Xin chào các bạn
Oanh Thơ đang sử dụng code sau để copy dữ liệu từ vùng "B7

99" của Sheet1
Sang vùng "E10" của sheet2:

Mã:

Sub CopyData()
Sheets("Sheet1").Range("B7:D99").Copy
Sheets("Sheet2").Range("E10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

Nhờ các bạn giúp đỡ cách viết khác sử dụng mảng ạ.

Quang_Hải · 30/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn
Oanh Thơ đang sử dụng code sau để copy dữ liệu từ vùng "B799" của Sheet1
Sang vùng "E10" của sheet2:

Mã:

Sub CopyData() Sheets("Sheet1").Range("B7:D99").Copy Sheets("Sheet2").Range("E10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True End Sub

Nhờ các bạn giúp đỡ cách viết khác sử dụng mảng ạ.

Mã:

Sub Doc_Ngang()
Dim sArr(), dArr(), i As Long, j&
sArr = Sheets("Sheet1").Range("B7:D99").Value
ReDim dArr(1 To UBound(sArr, 2), 1 To UBound(sArr))
For i = 1 To UBound(sArr)
   For j = 1 To UBound(sArr, 2)
      dArr(j, i) = sArr(i, j)
   Next
Next
Sheets("sheet2").[E10].Resize(UBound(dArr), UBound(dArr, 2)) = dArr
End Sub

Kiều Mạnh · 30/10/18

quanghai1969 đã viết:

Mã:

Sub Doc_Ngang()
Dim sArr(), dArr(), i As Long, j&
sArr = Sheets("Sheet1").Range("B7:D99").Value
ReDim dArr(1 To UBound(sArr, 2), 1 To UBound(sArr))
For i = 1 To UBound(sArr)
   For j = 1 To UBound(sArr, 2)
      dArr(j, i) = sArr(i, j)
   Next
Next
Sheets("sheet2").[E10].Resize(UBound(dArr), UBound(dArr, 2)) = dArr
End Sub

Em mới thử làm đơn giản vầy nó cũng ra đó Anh

Mã:

Sub TransposeArr()
    Dim Arr(), lRow As Long, lCols  As Long
    Arr = Range("B7:D99").Value
    lRow = UBound(Arr, 1)
    lCols = UBound(Arr, 2)
    Range("E10").Resize(lCols, lRow).Value = Application.WorksheetFunction.Transpose(Arr)
End Sub

VetMini · 30/10/18

kieu manh đã viết:
Em mới thử làm đơn giản vầy nó cũng ra đó Anh

Mã:

Sub TransposeArr() Dim Arr(), lRow As Long, lCols As Long Arr = Range("B7:D99").Value lRow = UBound(Arr, 1) lCols = UBound(Arr, 2) Range("E10").Resize(lCols, lRow).Value = Application.WorksheetFunction.Transpose(Arr) End Sub

Hàm WorksheetFunction nó có giới hạn của nó:
1. Text chỉ được khoảng 255 ký tự
2. Chỉ được khoảng 500 dòng
Các con số trên, tôi có thể sai một chút. Nhưng chuyện giới hạn là chuyện thực tế.
Thử vài ô với text dài xem.

Hoàng Nhật Phương · 30/10/18

quanghai1969 đã viết:

Mã:

Sub Doc_Ngang()
Dim sArr(), dArr(), i As Long, j&
sArr = Sheets("Sheet1").Range("B7:D99").Value
ReDim dArr(1 To UBound(sArr, 2), 1 To UBound(sArr))
For i = 1 To UBound(sArr)
   For j = 1 To UBound(sArr, 2)
      dArr(j, i) = sArr(i, j)
   Next
Next
Sheets("sheet2").[E10].Resize(UBound(dArr), UBound(dArr, 2)) = dArr
End Sub

Cảm ơn anh @quanghai1969 và các bạn đã hỗ trợ,
Nhờ các bạn giúp Oanh Thơ trường hợp đưa dữ liệu của vùng màu vàng trong cột C sang vùng màu vàng trong cột G, cũng sử dụng mảng với ạ:

befaint · 30/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
đưa dữ liệu của vùng màu vàng trong cột C sang vùng màu vàng trong cột G, cũng sử dụng mảng

Bài này có nhiều rồi đó. Tìm mấy chủ đề về chèn dòng ấy...
Hình như có cả code tổng quát cho n dòng, rồi dùng 1 vòng lặp..

snow25 · 30/10/18

đưa vào như hình ở cột g hả bạn

Hoàng Nhật Phương · 30/10/18

snow25 đã viết:
đưa vào như hình ở cột g hả bạn

Xin chao snow25,
Dạ, đúng như vậy đưa từ cột C sang cột G ạ.

snow25 · 30/10/18

snow25 đã viết:
đưa vào như hình ở cột g hả bạn

vậy bạn dùng vòng lặp là được mà.gán cái vùng ở cột c vào mảng rồi duyệt mảng chuyển qua mảng khác gắn vào cái cột G là được à

Hoàng Nhật Phương · 30/10/18

snow25 đã viết:
vậy bạn dùng vòng lặp là được mà.gán cái vùng ở cột c vào mảng rồi duyệt mảng chuyển qua mảng khác gắn vào cái cột G là được à

Cảm ơn bạn đã gợi ý, theo gợi ý của bạn @befaint ,Oanh Thơ đang thử sửa theo code bài này của thầy @Ba Tê trong bài viết:
https://www.giaiphapexcel.com/diendan/threads/làm-sao-để-insert-dòng-trong-vba-nhỉ.764/#post-864043
hihi, đang lỗi tùm lum hết cả.

snow25 · 30/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã gợi ý, theo gợi ý của bạn @befaint ,Oanh Thơ đang thử sửa theo code bài này của thầy @Ba Tê trong bài viết:
https://www.giaiphapexcel.com/diendan/threads/làm-sao-để-insert-dòng-trong-vba-nhỉ.764/#post-864043
hihi, đang lỗi tùm lum hết cả.

đây bạn xem code này được không nhé

Mã:

Sub chuyendulieu()
Dim arr, arr1
Dim i As Long, a As Long
arr = Sheet1.Range("c3:c7").Value
ReDim arr1(1 To UBound(arr, 1) * 5, 1 To 1)
a = 1
  For i = 1 To UBound(arr, 1)
      arr1(a, 1) = arr(i, 1)
      a = a + 5
  Next i
    Sheet1.Range("h3").Resize(a, 1).Value = arr1
End Sub

Hoàng Nhật Phương · 30/10/18

snow25 đã viết:
đây bạn xem code này được không nhé

Mã:

Sub chuyendulieu() Dim arr, arr1 Dim i As Long, a As Long arr = Sheet1.Range("c3:c7").Value ReDim arr1(1 To UBound(arr, 1) * 5, 1 To 1) a = 1 For i = 1 To UBound(arr, 1) arr1(a, 1) = arr(i, 1) a = a + 5 Next i Sheet1.Range("h3").Resize(a, 1).Value = arr1 End Sub

Cảm ơn bạn đã hỗ trợ, Oanh Thơ (OT) loay hoay mãi mà vẫn chưa ra.
Híc xem code của bạn không thấy dễ như Oanh nghĩ chút nào thì ra phải dùng ReDim và dùng 2 mảng mới xong.
Code của bạn chay đúng rồi, còn ô cuối cùng của trong cột G bị lỗi #NA ạ.

snow25 · 30/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã hỗ trợ, Oanh Thơ (OT) loay hoay mãi mà vẫn chưa ra.
Híc xem code của bạn không thấy dễ như Oanh nghĩ chút nào thì ra phải dùng ReDim và dùng 2 mảng mới xong.
Code của bạn chay đúng rồi, còn ô cuối cùng của trong cột G bị lỗi #NA ạ.

vậy bạn sửa cho Riseze là a-1 là được nhé

VetMini · 30/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã hỗ trợ, Oanh Thơ (OT) loay hoay mãi mà vẫn chưa ra.
Híc xem code của bạn không thấy dễ như Oanh nghĩ chút nào thì ra phải dùng ReDim và dùng 2 mảng mới xong.
Code của bạn chay đúng rồi, còn ô cuối cùng của trong cột G bị lỗi #NA ạ.

Code trên đếm a dư 1.
Đếm như vầy mới đúng:
a = 0
For i = 1 To UBound(arr, 1)
a = a + 1
arr1(a, 1) = arr(i, 1)
a = a + 4
Next i
Nhưng mà nó luộm thuộm lắm. Tính luôn chỉ số cho nó gọn:
For i = 1 To UBound(arr1, 1) Step
arr1((i - 1) * 5 + 1, 1) = arr(i, 1)
Next i

Hoàng Nhật Phương · 31/10/18

Xin chào các bạn,
Oanh Thơ sử dụng code của snow25, để chuyển dữ liệu từ cột C

sang cột K:L
Cách chuyển cứ mỗi 1 dòng tại cột C

thì tạo thành 5 dòng liên tục giống nhau tại cột K:L như ảnh kèm.

Mã:

Sub Chuyen_DL()
    Dim i As Long, j As Long, a As Long, LastRow As Long
    Dim sh As Worksheet, arr As Variant, arr1 As Variant
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    LastRow = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row
    arr = sh.Range("C1:D" & LastRow).Value
    ReDim arr1(1 To UBound(arr, 1) * 5, 1 To 2)
    a = 0
    For i = 1 To UBound(arr, 1)
        a = a + 1
        arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2)
        a = a + 4
    Next i
    With sh.Range("K1").Resize(a, 2)
        .Value = arr1
        .SpecialCells(xlCellTypeBlanks).Value = "=R[-1]C"
        .Value = .Value
    End With
End Sub

Hiện tại 2 dòng:

.SpecialCells(xlCellTypeBlanks).Value = "=R[-1]C"
.Value = .Value

đang làm việc với Range, nhờ các bạn chuyển giúp sang cách dùng mảng ạ

befaint · 31/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cách chuyển cứ mỗi 1 dòng tại cột C thì tạo thành 5 dòng liên tục giống nhau tại cột K:L như ảnh kèm.

Cuối cùng cũng lòi cái đuôi ra. Đã bảo có chủ đề như này rồi. Có cả phương án code và công thức rồi sort.

Hoàng Nhật Phương · 31/10/18

befaint đã viết:
Cuối cùng cũng lòi cái đuôi ra. Đã bảo có chủ đề như này rồi. Có cả phương án code và công thức rồi sort.

hihi, khổ ghê OT cũng tìm rồi đó mà.
híc OT sẽ tìm tiếp và nghĩ tiếp ạ. @befaint biết link rồi thì trích cho OT tham khảo với.
Còn code trên cũng xài OK rồi nhưng OT muốn học và dùng mảng ạ.

Quang_Hải · 31/10/18

Mã:

Sub Chuyen_DL()
Dim Arr1(), Arr2(), i&, j&, a&, n&
With Sheets("Sheet1")
   Arr1 = .Range("C1", .[D65536].End(3)).Value
    ReDim Arr2(1 To UBound(Arr1, 1) * 5, 1 To UBound(Arr1, 2))
    For i = 1 To UBound(Arr1, 1)
      For n = 0 To 4
         For j = 1 To UBound(Arr1, 2)
            Arr2(a + n + 1, j) = Arr1(i, j)
         Next
      Next
      a = a + 5
    Next i
   .[K1].Resize(UBound(Arr2), UBound(Arr2, 2)) = Arr2
End With
End Sub

Kiều Mạnh · 31/10/18

VetMini đã viết:
Hàm WorksheetFunction nó có giới hạn của nó:
1. Text chỉ được khoảng 255 ký tự
2. Chỉ được khoảng 500 dòng
Các con số trên, tôi có thể sai một chút. Nhưng chuyện giới hạn là chuyện thực tế.
Thử vài ô với text dài xem.

Nếu dữ liệu 65536 dòng x 20 cột mà xài WorksheetFunction thì có mà tèo téo teo...

Cho vô mảng chạy 2 dòng For cho nó đẹp code nó bay cái Vèo

befaint · 31/10/18

quanghai1969 đã viết:
For i = 1 To UBound(Arr1, 1)
For n = 0 To 4

Chỗ này em nhớ có một bác nói là dùng một vòng lặp thôi..

tam888 · 31/10/18

kieu manh đã viết:
Nếu dữ liệu 65536 dòng x 20 cột mà xài WorksheetFunction thì có mà tèo téo teo...

Cho vô mảng chạy 2 dòng For cho nó đẹp code nó bay cái Vèo

Nếu dữ liệu nhiều vậy, thì dùng excel làm chi - khi công ty giàu (dữ liệu nhiều chứng tỏ nhiều hoạt động) rồi

♫ђöล♥ßล†♥†µ♫ · 31/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
hihi, khổ ghê OT cũng tìm rồi đó mà.
híc OT sẽ tìm tiếp và nghĩ tiếp ạ. @befaint biết link rồi thì trích cho OT tham khảo với.
Còn code trên cũng xài OK rồi nhưng OT muốn học và dùng mảng ạ.

Em cũng học nữa $-\\/.$

PHP:

Sub ChuyenDL()
    Dim sArr(), dArr(), I As Long, Idx As Long, K As Long, J As Long, N As Long: N = 5
sArr = Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
ReDim dArr(1 To UBound(sArr) * N, 1 To UBound(sArr, 2))
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> mpty Then
        For Idx = 1 To N
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next J
        Next Idx
    End If
Next I
If K Then Range("K1").Resize(K, UBound(sArr, 2)) = dArr
End Sub

befaint · 31/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
N As Long: N = 5

Chỗ này: Const N as Long = 5 và để trên cùng (Lần trước một bác chỉ cho mình như vậy).
Thêm ý ở bài #1038 nữa nhé

Mã:

UBound(sArr) * N
'...'
K
'//Cần kiểm tra so với số dòng tối đa của bảng tính

Mã:

For J = 1 To UBound(sArr, 2) '// thêm biến gán giá trị UBound(sArr, 2)  để không phải gọi lại chỗ đó nhiều lần

♫ђöล♥ßล†♥†µ♫ · 31/10/18

befaint đã viết:
Chỗ này: Const N as Long = 5 và để trên cùng (Lần trước một bác chỉ cho mình như vậy).
Thêm ý ở bài #1038 nữa nhé

Mã:

UBound(sArr) * N '...' K '//Cần kiểm tra so với số dòng tối đa của bảng tính

Mã:

For J = 1 To UBound(sArr, 2) '// thêm biến gán giá trị UBound(sArr, 2) để không phải gọi lại chỗ đó nhiều lần

Dạ. Cái này Anh nhắc Em mấy lần mà Em toàn quên thôi. Em cám ơn Anh nhiều

Hoàng Nhật Phương · 31/10/18

Xin cảm ơn anh, chị và các bạn đã giúp đỡ ạ.
Các code trên đều chạy ra kết quả OK rồi.

Trong trường hợp dữ liệu trả về trong cột K:L (dữ liệu cột C đưa sang cột L,dữ liệu cột D đưa sang cột K) như ảnh kèm thì code của @quanghai1969 và @♫ђöล♥ßล†♥†µ♫(ôi cái tên ..đẹp ^^) thì phải sửa như thế nào ạ?
Híc mong các bạn đừng hiểu nhầm ạ , OT đang học hỏi để biết cách tự điều chỉnh,chứ thực tế dữ liệu hiện tại đang không phải như vậy,nhưng cũng có thể sẽ gặp ạ.
Nếu các bạn có thời gian mong được các bạn chỉ dẫn ạ.

Quang_Hải · 31/10/18

befaint đã viết:
Chỗ này em nhớ có một bác nói là dùng một vòng lặp thôi..

Code ngắn cũng có cái hay nhưng khó nhìn thuật toán trong code. Code dài lê thê nhìn thấy gớm nhưng cần điều chỉnh thì lại dễ hơn đối với những người chỉ dùng VBA trong công việc văn phòng hàng ngày. Người khéo sẽ biết chọn phương án phù hợp cho từng trường hợp mà.

♫ђöล♥ßล†♥†µ♫ · 31/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin cảm ơn anh, chị và các bạn đã giúp đỡ ạ.
Các code trên đều chạy ra kết quả OK rồi.

Trong trường hợp dữ liệu trả về trong cột K:L (dữ liệu cột C đưa sang cột L,dữ liệu cột D đưa sang cột K) như ảnh kèm thì code của @quanghai1969 và @♫ђöล♥ßล†♥†µ♫(ôi cái tên ..đẹp ^^) thì phải sửa như thế nào ạ?
Híc mong các bạn đừng hiểu nhầm ạ , OT đang học hỏi để biết cách tự điều chỉnh,chứ thực tế dữ liệu hiện tại đang không phải như vậy,nhưng cũng có thể sẽ gặp ạ.
Nếu các bạn có thời gian mong được các bạn chỉ dẫn ạ.

View attachment 206779

Em chế nó ra thế này. Nhân tiện luyện mấy cái Anh @befaint chỉ

PHP:

Sub ChuyenDL()
    Dim sArr(), dArr(), I As Long, Idx As Long, K As Long, J As Long, _
    R As Long, C As Long, Jdx As Long, sRng As Range
Const N As Long = 5
Set sRng = Range("K1")
sArr = Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
R = UBound(sArr, 1): C = UBound(sArr, 2)
If R > Rows.Count - sRng.Row Then
    MsgBox "Hands On.com"
    Exit Sub
End If
ReDim dArr(1 To R * N, 1 To C)
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
        For Idx = 1 To N
            K = K + 1: Jdx = 0
            For J = C To 1 Step -1
                Jdx = Jdx + 1:  dArr(K, Jdx) = sArr(I, J)
            Next J
        Next Idx
    End If
Next I
sRng.Resize(K, UBound(sArr, 2)) = dArr
End Sub

Hoàng Nhật Phương · 31/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Em chế nó ra thế này. Nhân tiện luyện mấy cái Anh @befaint chỉ

PHP:

Sub ChuyenDL()
    Dim sArr(), dArr(), I As Long, Idx As Long, K As Long, J As Long, R As Long, C As Long, Jdx As Long
Const N As Long = 5
sArr = Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
R = UBound(sArr, 1): C = UBound(sArr, 2)
ReDim dArr(1 To R * N, 1 To C)
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> mpty Then
        For Idx = 1 To N
            K = K + 1: Jdx = 0
            For J = C To 1 Step -1
                Jdx = Jdx + 1:  dArr(K, Jdx) = sArr(I, J)
            Next J
        Next Idx
    End If
Next I
With Range("K1")
    If K < Rows.Count - .Row Then
        If K Then .Resize(K, UBound(sArr, 2)) = dArr
    Else
        MsgBox "Hands On.com"
    End If
End With
End Sub

Xin chào ♫ђöล♥ßล†♥†µ♫,
Cảm ơn bạn rất nhiều, code bị lỗi dòng "If sArr(I, 1) <> mpty Then", OT sửa lại "If sArr(I, 1) <> Empty Then" thì OK rồi bạn ạ.
Chắc bạn sửa luôn trên này chưa thử code (OT thấy người nào giỏi giỏi cái gì đó có ích, thấy ngưỡng mộ quá ^^)

concogia · 31/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin cảm ơn anh, chị và các bạn đã giúp đỡ ạ.
Các code trên đều chạy ra kết quả OK rồi.

Trong trường hợp dữ liệu trả về trong cột K:L (dữ liệu cột C đưa sang cột L,dữ liệu cột D đưa sang cột K) như ảnh kèm thì code của @quanghai1969 và @♫ђöล♥ßล†♥†µ♫(ôi cái tên ..đẹp ^^) thì phải sửa như thế nào ạ?
Híc mong các bạn đừng hiểu nhầm ạ , OT đang học hỏi để biết cách tự điều chỉnh,chứ thực tế dữ liệu hiện tại đang không phải như vậy,nhưng cũng có thể sẽ gặp ạ.
Nếu các bạn có thời gian mong được các bạn chỉ dẫn ạ.

View attachment 206779

Thử code này, dữ liệu gì mà bắt đầu từ hàng 1, ngộ vậy, muốn từ hàng nào thì sửa trong code nhé:

Mã:

Public Sub Teo()
    Dim Vung, Kq, I, J
    Vung = Range([C2], [C50000].End(xlUp)).Resize(, 2)
    ReDim Kq(1 To UBound(Vung) * 5, 1 To 2)
        For I = 1 To UBound(Kq)
            J = J + IIf(I Mod 5 = 1, 1, 0)
            Kq(I, 2) = Vung(J, 1): Kq(I, 1) = Vung(J, 2)
        Next I
    [K2].Resize(UBound(Kq), 2) = Kq
End Sub

Thân

VetMini · 31/10/18

kieu manh đã viết:
Nếu dữ liệu 65536 dòng x 20 cột mà xài WorksheetFunction thì có mà tèo téo teo...

Cho vô mảng chạy 2 dòng For cho nó đẹp code nó bay cái Vèo

20x65000 = 1,3 triệu Variants
Máy cùi 1 chút cũng vỡ mật (out of memory) khỏi cần vòng pho phiếc gì cả.

Hoàng Nhật Phương · 31/10/18

concogia đã viết:
Thử code này, dữ liệu gì mà bắt đầu từ hàng 1, ngộ vậy, muốn từ hàng nào thì sửa trong code nhé:

Mã:

Public Sub Teo() Dim Vung, Kq, I, J Vung = Range([C2], [C50000].End(xlUp)).Resize(, 2) ReDim Kq(1 To UBound(Vung) * 5, 1 To 2) For I = 1 To UBound(Kq) J = J + IIf(I Mod 5 = 1, 1, 0) Kq(I, 2) = Vung(J, 1): Kq(I, 1) = Vung(J, 2) Next I [K2].Resize(UBound(Kq), 2) = Kq End Sub

Thân

Xin chào @concogia ,
Cảm ơn bạn đã quan tâm và giúp đỡ dữ liệu Oanh Thơ gửi lên hiện thời mang tính minh họa mục đích để Oanh Thơ học hỏi về mảng và chắc chắn sau hi vọng sau sẽ ứng dụng được ít nhiều vào thực tế trong công việc ạ.
Không ngờ mảng lại tuyệt vời đến với đến vậy.Nhanh, nhanh quá!

Hoàng Nhật Phương · 4/11/18

Xin chào các bạn,
Tôi muốn gán vùng dữ liệu C1:O1 vào DataValidation/list cho ô A1 và tôi đã thử code dưới bị lỗi chưa biết cách, nhờ các bạn xem giúp.

Mã:

Sub TestValidation()
    Dim ary As Variant
    ary = Sheets("Sheet1").Range("C1:O1").Value
    ary = Application.Transpose(ary)
    With Sheets("Sheet1").Cells(1, 1).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary
End Sub

SA_DQ · 4/11/18

Nếu là mình thì sẽ làm như sau:

B1: Đánh số cách quãng các dòng lệnh & thêm các dòng lệnh để bẫy lỗi, như sau:

Mã:

Sub TestValidation()
    Dim ary As Variant
On Error GoTo LoiCT
2    ary = Sheets("Sheet1").Range("C1:O1").Value
    ary = Application.Transpose(ary)
4    With Sheets("Sheet1").Cells(1, 1).Validation
        .Delete
6        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
        .IgnoreBlank = True:            .InCellDropdown = True
8        .InputTitle = "":                   .ErrorTitle = ""
        .InputMessage = "":             .ErrorMessage = ""
10        .ShowInput = True:              .ShowError = True
    End With
12    Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary
Err_:   Exit Sub
LoiCT:
    MsgBox Error, , Erl
    Resume Err_
End Sub

B1.1 Chạy thử Code để biết gần đúng dòng nào bị lỗi & lỗi là gì
(Sau khi thực hiện, macro báo ta biết dòng 6 bị lỗi; Nhưng ta đang đánh số cách quãng, nên lỗi có thể ở dòng 5 hay 7 nữa kia

B1.2: Ta lại tìm đúng dòng bị lỗi bằng cách đánh lại chỉ là:

PHP:

Sub TestValidation()
    Dim ary As Variant
On Error GoTo LoiCT
    ary = Sheets("Sheet1").Range("C1:O1").Value
    ary = Application.Transpose(ary)
    With Sheets("Sheet1").Cells(1, 1).Validation
5        .Delete
6        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
7        .IgnoreBlank = True:            .InCellDropdown = True
        .InputTitle = "":                   .ErrorTitle = ""
        .InputMessage = "":             .ErrorMessage = ""
        .ShowInput = True:              .ShowError = True
    End With
    Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary
Err_:   Exit Sub
LoiCT:
    MsgBox Error, , Erl
    Resume Err_
End Sub

Sau khi lặp lại B1.1 ta biết đúng dòng 6 bị lỗi & nội dung lỗi là gì.

B2: Tìm mã lỗi của nội dung lỗi & viết lại cách dòng lệnh để bẫy lỗi:
Bằng cách thay dòng lệnh
MsgBox Error, , Erl
bỡi dòng lệnh: MsgBox Err, , Error
Ta biết được Err => 5
Ta sửa lại các dòng lệnh bẫy lỗi như sau:

Mã:

' . . .     '
Err_:   Exit Sub
LoiCT:
    If Err = 5 Then
        Resume Err_
    Else
        Resume Next
    End If
End Sub

Bạn thử tiếp tục tìm lỗi của đứa con tinh thần của bạn thử xem sao & chúc thành công!

batman1 · 4/11/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Tôi muốn gán vùng dữ liệu C1:O1 vào DataValidation/list cho ô A1 và tôi đã thử code dưới bị lỗi chưa biết cách, nhờ các bạn xem giúp.

Mã:

Sub TestValidation() Dim ary As Variant ary = Sheets("Sheet1").Range("C1:O1").Value ary = Application.Transpose(ary) With Sheets("Sheet1").Cells(1, 1).Validation .Delete .Add Type:=xlValidateList, Formula1:=Join(ary, ",") .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary End Sub

Sai do JOIN chỉ chấp nhận mảng 1 chiều. Trong code của bạn ở thời điểm ADD thì ary là mảng 2 chiều có 13 dòng và 1 cột.

Sửa thành

Mã:

Sub TestValidation()
Dim ary As Variant
    ary = Sheets("Sheet1").Range("C1:O1").Value
    ary = Application.Transpose(ary)
    
    Sheets("Sheet1").Cells(1, "B").Resize(UBound(ary)).Value = ary
    ary = Application.Transpose(ary)
    
    With Sheets("Sheet1").Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Sau dòng

Mã:

ary = Sheets("Sheet1").Range("C1:O1").Value

ary là mảng 2 chiều có 1 dòng và 13 cột.

Sau dòng

Mã:

ary = Application.Transpose(ary)

thứ nhất ary là mảng 2 chiều có 13 dòng và 1 cột

Sau dòng

Mã:

ary = Application.Transpose(ary)

thứ hai ary là mảng 1 chiều có 13 phần tử (không có khái niệm dòng hay cột). Lúc này ary mới được vinh dự hầu ông JOIN.

Nói cho cùng tôi và nhiều người chỉ hơn bạn chủ yếu là chúng tôi đọc help còn bạn không đọc. Một kho kiến thức ngay bên cạnh mà cứ chạy đi hỏi đâu đâu.

batman1 · 4/11/18

SA_DQ đã viết:
Nếu là mình thì sẽ làm như sau:

B1: Đánh số cách quãng các dòng lệnh & thêm các dòng lệnh để bẫy lỗi, như sau:

Mã:

Sub TestValidation() Dim ary As Variant On Error GoTo LoiCT 2 ary = Sheets("Sheet1").Range("C1:O1").Value ary = Application.Transpose(ary) 4 With Sheets("Sheet1").Cells(1, 1).Validation .Delete 6 .Add Type:=xlValidateList, Formula1:=Join(ary, ",") .IgnoreBlank = True: .InCellDropdown = True 8 .InputTitle = "": .ErrorTitle = "" .InputMessage = "": .ErrorMessage = "" 10 .ShowInput = True: .ShowError = True End With 12 Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary Err_: Exit Sub LoiCT: MsgBox Error, , Erl Resume Err_ End Sub

B1.1 Chạy thử Code để biết gần đúng dòng nào bị lỗi & lỗi là gì

Không cần đoạn trên cũng biết "gần đúng" lỗi ở đâu. Khi chạy code thì dòng

Mã:

.Add Type:=xlValidateList, Formula1:=Join(ary, ",")

bị đánh dấu - cứ cho là gần đúng đi.

...
Sau khi lặp lại B1.1 ta biết đúng dòng 6 bị lỗi & nội dung lỗi là gì.

B2: Tìm mã lỗi của nội dung lỗi

Khi bị lỗi thì sẽ có cửa sổ nhẩy ra ghi rõ nội dung lỗi và cả mã lỗi. Chả cần làm gì cũng biết nội dung và mã lỗi. Muốn biết lỗi ở dòng nào (cứ cho là gần đúng đi) thì nhấn Debug ở cửa sổ báo lỗi.

Cũng chả cần tới hàm Error

Mã:

MsgBox Err.Description, , Err.Number

Khi cần thì Err.Clear, Err.Raise. Tất cả nằm trong đối tượng Err

Tìm dòng lỗi chỉ là một chuyện nhỏ. Mà thường thì ta cũng được chỉ ra "khu vực" bị lỗi. Cái quan trọng là tìm ra nguyên nhân, thủ phạm. Để làm được điều đó thì phải chịu khó tư duy, phán đoán và nếu cần thì đọc trợ giúp. Đọc về cái gì thì tư duy và phán đoán sẽ chỉ đường.

Vd. trong trường hợp ở trên thì giá trị xlValidateList là hợp lệ - ít ra là ta có 99% chắc chắn là thế. Còn lại Join(ary, ",") thì "nhìn" có vẻ "ổn", nhưng đây là hàm chứ không phải là hằng như xlValidateList. Vậy ta tìm đọc lại về JOIN xem có chỗ nào ta dùng sai dấu, sai ký tự hay sai gì đó không. Có rất nhiều khi ta có hàm xịn, dùng mấy năm rồi, nhưng hôm nay giở chứng. Nếu là hàm xịn, mà JOIN là hàm xịn, thì 99% lỗi là do truyền tham số không hợp lệ vào hàm.

SA_DQ · 4/11/18

Tìm dòng lỗi chỉ là một chuyện nhỏ. Mà thường thì ta cũng được chỉ ra "khu vực" bị lỗi. Cái quan trọng là tìm ra nguyên nhân, thủ phạm

Tuổi nhỏ làm việc nhỏ, tùy theo sức của mình mà lị!

Bạn í cần đi bộ lên các bậc thang VBA; Dù có thể 2 bậc 1 bước. Nhưng chưa thể đi thang máy được đâu; chắc vậy!

Hoàng Nhật Phương · 4/11/18

Cháu cảm ơn hai bác SA_DQ và Siwtom đã giúp cháu.
Nhờ vào các giải thích chi tiết cháu cũng đã hiểu thêm một chút về mảng là như thế nào.
Hiện cháu đang loay hoay, khi gán dữ liệu mảng rồi,ví dụ:

ary = Sheets("Sheet1").Range("C1:O1").Value

thì làm thế nào để sử dụng các vòng lặp duyệt từng phần tử trong mảng 2 chiều để trả về mảng 1 chiều mà không phải sử dụngTranspose(ary)
nữa ạ.
Nếu hai bác và các bạn có hứng thú thời gian góp ý cho cháu thêm những cách để cháu tham khảo thêm ạ.

Hoàng Nhật Phương · 4/11/18

Xin chào các bạn,
Nhờ các bạn giúp đỡ cho tôi trường hợp sau với, làm thế nào để có thể gán được các con số như trong list tại ô A1, với điều kiện:
Các con số được lấy trong vùng "C1:O1" (vấn đề đã được xử lý ở bài 1052),
Nhưng thêm 1 điều kiện rút ngắn list lại, loại bỏ những cột(list) không có số liệu trong vùng "C2:O12"

snow25 · 4/11/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Nhờ các bạn giúp đỡ cho tôi trường hợp sau với, làm thế nào để có thể gán được các con số như trong list tại ô A1, với điều kiện:
Các con số được lấy trong vùng "C1:O1" (vấn đề đã được xử lý ở bài 1052),
Nhưng thêm 1 điều kiện rút ngắn list lại, loại bỏ những cột(list) không có số liệu trong vùng "C2:O12"

View attachment 206982

đây bạn xem nhé không biết có ổn không

Mã:

Sub TestValidation()
Dim ary As Variant, i As Long
    ary = Sheets("Sheet1").Range("C1:O1").Value
    For i = 1 To UBound(ary, 2)
        If WorksheetFunction.CountA(Sheet1.Cells(2, 2 + i).Resize(10, 1)) = 0 Then
           ary(1, i) = Empty
        End If
    Next i
    
    ary = Application.Transpose(ary)
    
    Sheets("Sheet1").Cells(1, "B").Resize(UBound(ary)).Value = ary
    ary = Application.Transpose(ary)
    
    With Sheets("Sheet1").Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

batman1 · 4/11/18

SA_DQ đã viết:
Tuổi nhỏ làm việc nhỏ, tùy theo sức của mình mà lị!

Bạn í cần đi bộ lên các bậc thang VBA; Dù có thể 2 bậc 1 bước. Nhưng chưa thể đi thang máy được đâu; chắc vậy!

Bạn để ý thì thấy tôi không nói tới đoạn

B1.2: Ta lại tìm đúng dòng bị lỗi bằng cách đánh lại chỉ là:
PHP:

Sub TestValidation()
Dim ary As Variant
On Error GoTo LoiCT
ary = Sheets("Sheet1").Range("C1:O1").Value
ary = Application.Transpose(ary)
With Sheets("Sheet1").Cells(1, 1).Validation
5 .Delete
6 .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
7 .IgnoreBlank = True: .InCellDropdown = True
.InputTitle = .ErrorTitle = ""
.InputMessage = .ErrorMessage = ""
.ShowInput = True: .ShowError = True
End With
Sheets("Sheet1").Cells(1, 2).Resize(UBound(ary)).Value = ary
Err_: Exit Sub
LoiCT:
MsgBox Error, , Erl
Resume Err_
End Sub

Vì theo tôi đoạn đó có thể có ích cho người hỏi.

Còn những đoạn trước và sau nó không cần vì khi chạy code bạn đã được cung cấp thông tin quá rõ ràng rồi.

batman1 · 4/11/18

Nguyễn Hoàng Oanh Thơ đã viết:
Hiện cháu đang loay hoay, khi gán dữ liệu mảng rồi,ví dụ:
thì làm thế nào để sử dụng các vòng lặp duyệt từng phần tử trong mảng 2 chiều để trả về mảng 1 chiều mà không phải sử dụngTranspose(ary) nữa ạ.

Thì dùng FOR *** thôi.

Nhưng trước hết phải biết mảng có bao nhiêu dòng và cột để duyệt theo dòng hay cột hay theo cả dòng và cột.
arr = vung.Value
1. Nếu arr được khai báo là mảng (Dim arr()) thì khi vùng là 1 ô (cell) thì sẽ có lỗi. Khi Dim arr (arr là Variant) thì không có lỗi.

2. Nếu vung là 1 ô thì arr (Dim arr) là 1 giá trị, không phải là mảng.

3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dòng.

Trong code tổng quát thì phải lường được dữ liệu để xem dữ liệu có có không, có thể chỉ là 1 giá trị hay luôn là mảng ... Vd. Muốn tuồn các giá trị từ B2 tới ô cuối cùng không trống trong cột B vào mảng. Có thể sẩy ra trường hợp không có dữ liệu (từ B2 trở đi đều trống), chỉ có 1 ô (B2<>"" và từ B3 là trống), và nhiều ô. Nhưng nếu muốn tuồn từ B2:C2 tới "cuối" thì chỉ sẩy ra 2 trường hợp: hoặc không có dữ liệu hoặc nhiều ô (ít nhất là 1 dòng tuồn vào mảng, mà dòng Bk:Ck luôn có 2 ô)
---------
Theo bạn thì code tuồn cứng nhắc một vùng có nhiều ô vào mảng nên ta cũng không kiểm tra mà biết ngay ary là mảng 2 chiều có 1 dòng và nhiều cột. Vậy ta duyệt mảng theo dòng.

Mã:

Sub test()
Dim c As Long, result(), ary, s As String
    ary = Sheets("Sheet1").Range("C1:O1").Value
    ReDim result(1 To UBound(ary, 2))
    For c = 1 To UBound(ary, 2) '   To UBound(result)
        result(c) = ary(1, c)
    Next c
    s = Join(result, ",")
    MsgBox s
End Sub

***: đừng phát âm là phò nhé. Lại nhớ hồi nhỏ ở phố có "chị" hay đi chơi với nhiều anh. Bọn trẻ chỉ trỏ và nói: phò phi dê. Các bạn trẻ có biết phi dê là gì không?

Hoàng Nhật Phương · 4/11/18

snow25 đã viết:

đây bạn xem nhé không biết có ổn không

Mã:

Sub TestValidation()
Dim ary As Variant, i As Long
    ary = Sheets("Sheet1").Range("C1:O1").Value
    For i = 1 To UBound(ary, 2)
        If WorksheetFunction.CountA(Sheet1.Cells(2, 2 + i).Resize(10, 1)) = 0 Then
           ary(1, i) = Empty
        End If
    Next i
   
    ary = Application.Transpose(ary)
   
    Sheets("Sheet1").Cells(1, "B").Resize(UBound(ary)).Value = ary
    ary = Application.Transpose(ary)
   
    With Sheets("Sheet1").Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Xin chào snow25,
Cảm ơn bạn đã tham gia & giúp đỡ, OT vừa mới test code trên trả về kết quả đúng với mong muốn của Oanh Thơ rồi.
Tuy nhiên khi sử dụng mảng, nhờ snow25 và các bạn có thể làm thể nào để không phải sử dụng đến:
1.WorksheetFunction (đại loại vòng lặp không can thiệp vào Range)
2.Transpose (hay là giới hạn ký tự)
3.Loại bỏ các phần tử rỗng (Empty) , ví dụ trong hình ảnh tại bài 1056 (Oanh Thơ đưa lên) làm thế nào khi mà trả về mảng 1 chiếu cuối cùng thì các phần tử trong mảng chỉ chưa 7 phần tử thay vì đưa cả 13 phần tử vào (bao gồm cả rỗng). Tương tự cụ thể làm sao, để:

Sheets("Sheet1").Cells(1, "B").Resize(UBound(ary)).Value = ary

Không có các ô trống xen kẽ ạ.
Qua việc tự tìm hiểu (có thể là là sai ạ) OT thơ nghĩ trường hợp 3 cần có sự tham gia của Dictionary thì có thể giải quyết được?
Nếu đúng nhờ snow25 và các bạn giúp đỡ OT một đoạn code sử dụng kết hợp Dictionary để OT thấy được sự liên quan ạ.

Hoàng Nhật Phương · 4/11/18

batman1 đã viết:
Thì dùng FOR *** thôi.

Nhưng trước hết phải biết mảng có bao nhiêu dòng và cột để duyệt theo dòng hay cột hay theo cả dòng và cột.
arr = vung.Value
1. Nếu arr được khai báo là mảng (Dim arr()) thì khi vùng là 1 ô (cell) thì sẽ có lỗi. Khi Dim arr (arr là Variant) thì không có lỗi.

2. Nếu vung là 1 ô thì arr (Dim arr) là 1 giá trị, không phải là mảng.

3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dòng.

Trong code tổng quát thì phải lường được dữ liệu để xem dữ liệu có có không, có thể chỉ là 1 giá trị hay luôn là mảng ... Vd. Muốn tuồn các giá trị từ B2 tới ô cuối cùng không trống trong cột B vào mảng. Có thể sẩy ra trường hợp không có dữ liệu (từ B2 trở đi đều trống), chỉ có 1 ô (B2<>"" và từ B3 là trống), và nhiều ô. Nhưng nếu muốn tuồn từ B2:C2 tới "cuối" thì chỉ sẩy ra 2 trường hợp: hoặc không có dữ liệu hoặc nhiều ô (ít nhất là 1 dòng tuồn vào mảng, mà dòng Bk:Ck luôn có 2 ô)
---------
Theo bạn thì code tuồn cứng nhắc một vùng có nhiều ô vào mảng nên ta cũng không kiểm tra mà biết ngay ary là mảng 2 chiều có 1 dòng và nhiều cột. Vậy ta duyệt mảng theo dòng.

Mã:

Sub test() Dim c As Long, result(), ary, s As String ary = Sheets("Sheet1").Range("C1:O1").Value ReDim result(1 To UBound(ary, 2)) For c = 1 To UBound(ary, 2) ' To UBound(result) result(c) = ary(1, c) Next c s = Join(result, ",") MsgBox s End Sub

***: đừng phát âm là phò nhé. Lại nhớ hồi nhỏ ở phố có "chị" hay đi chơi với nhiều anh. Bọn trẻ chỉ trỏ và nói: phò phi dê. Các bạn trẻ có biết phi dê là gì không?

Kính chào bác Siwtom,
Cháu cảm ơn bác ạ, những chỉ dẫn:

....
3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dòng.
...

Rất chi tiết,cơ bản và dễ hiểu đối cho những người mới tiếp xúc đến mảng như cháu, hihi hóa ra LBound là con số bắt đầu và Ubound là con số kết thúc trong mảng.
Mảng trừu tượng thật đó,nếu không hiểu bản chất thì rất khó ứng dụng được. Giờ cháu mới thấy được phần nào về cái hay của mảng và hiểu được tại sao khi anh @viehoai code vba ầm ầm như vậy mà vẫn còn thắc mắc đến mảng

với anh ý còn như vậy thì không đối với người chậm hiểu và nhanh quên cháu không biết sẽ khi nào nữa. ~^^~

FOR.. cháu luôn hiểu là từ khóa của vòng lặp nên khi viết thì cứ nghĩ là "ÉpPhờ-O-RỜ" nên viết theo ạ,cháu không mấy khi để ý đến cách phát âm và nếu có phát âm thì cháu sẽ phát âm là Pho ạ

Cảm ơn bác Siwtom

tueyennhi · 23/11/18

VetMini đã viết:

Code tạo một mảng lớn liên tục từ 2 ranges

Mã:

' có 2 ranges, rg1 và rg2. Tạo một mảng lớn với dữ liệu từ 2 ranges này
Dim mang, mangPhu
Dim soCot as Long, soDong as Long, i as Long, j as long
soCot = Application.Max(rg1.columns.count, rg2.columns.count) ' số cột bắt buộc phải là số lớn giữa 2 ranges
soDong = rg1.rows.count + rg2.rows.count ' số dòng là tổng 2 ranges
mang = rg1.Resize(soDong, soCot).Value ' chép rg1 vào mảng, với số dòng dư
mangPhu = rg2.Resize(, soCot).Value ' chép rg2 vào mảng phụ
soDong = rg1.rows.count ' bắt đầu chép mảng phụ vào mảng chính
For i = 1 to rg2.rows.count
  soDong = soDong + 1
  For j = 1 to soCot
    mang(soDong, j) = mangPhu(i, j)
  Next j
Next i

Anh ơi cách này của em có gì sai mà mảng kết quả không đủ nhỉ

PHP:

Sub Xep_hang_CaNhan_2018()
With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
End With
With Sheets("Data")
    Dim mang, mangPhu
    Dim soCot As Long, soDong As Long, i As Long, j As Long
    Dim rg1 As Range, rg2 As Range
    mang = .Range("B6:F5000").Value2
    mangPhu = .Range("FE6:FO5000").Value2
    For i = 1 To UBound(mang, 1)
      For j = 7 To 17
        ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)
        mang(i, j) = mangPhu(i, j - 6)
      Next j
    Next i
End With
Sheets("cham chi").Range("V1").Resize(UBound(mang, 1), UBound(mang, 2)) = mang
End Sub

Em thấy nó lấy đến cột F của mảng mang, tiếp theo cột trống, tiếp theo nữa là dữ liệu cột FE, sau đó thì lại trống hoàn toàn. Kiểm tra số cột thì đúng bằng 17 như em chỉ định ở vòng lặp j.

tam888 · 23/11/18

tueyennhi đã viết:
Anh ơi cách này của em có gì sai mà mảng kết quả không đủ nhỉ

PHP:

Sub Xep_hang_CaNhan_2018() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("Data") Dim mang, mangPhu Dim soCot As Long, soDong As Long, i As Long, j As Long Dim rg1 As Range, rg2 As Range mang = .Range("B6:F5000").Value2 mangPhu = .Range("FE6:FO5000").Value2 For i = 1 To UBound(mang, 1) For j = 7 To 17 ReDim Preserve mang(1 To UBound(mang, 1), 1 To j) mang(i, j) = mangPhu(i, j - 6) Next j Next i End With Sheets("cham chi").Range("V1").Resize(UBound(mang, 1), UBound(mang, 2)) = mang End Sub

Em thấy nó lấy đến cột F của mảng mang, tiếp theo cột trống, tiếp theo nữa là dữ liệu cột FE, sau đó thì lại trống hoàn toàn. Kiểm tra số cột thì đúng bằng 17 như em chỉ định ở vòng lặp j.

Tư giải thích dòng này

Mã:

ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)

Nghĩa là sao, thì có thể thấy sai
và
Từ B->F thì chỉ có 5 cột?

befaint · 23/11/18

tueyennhi đã viết:
ReDim Preserve

Mục đích để làm gì.?

VetMini · 23/11/18

1. code dở ở chỗ này:

Với đoạn code này:

For i = 1 To UBound(mang, 1)
For j = 7 To 17
ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)

Bạn đã ReDim Preserve mang tất cả 11*4995 lần
Trong khi chỉ cần 1 lần đã đạt kết quả

ReDim Preserve mang(1 To UBound(mang, 1), 1 To 17)
For i = 1 To UBound(mang, 1)
For j = 7 To 17

2. dữ liệu bị mất vì lý do này:

For i = 1 To UBound(mang, 1)
' khi i = 1, vòng lặp kế tiếp chép dữ liệu vào cột 7 đến 17 của dòng 1
For j = 7 To 17
ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)
' khi i = 2, và j = 7, lệnh trên đặt lại số cột là 7 cho nên nó xoá cột 8-17 của dòng 1
' khi i = 3, và j = 7, lệnh trên xoá cột 8-17 của dòng 1 và 2
' tức là cứ mỗi lượt thì dòng trước bị xoá.

Gà cận thị · 23/11/18

Lót dép ngồi nghe mọi người bàn nhau về mảng

tueyennhi · 24/11/18

befaint đã viết:
Mục đích để làm gì.?

Mục đích của mình chỉ là gộp mảng Phụ vào mảng "mang". Dữ liệu nhiều cột quá lại cách xa nhau nên mình làm thế cho mảng đỡ lớn. Và chủ yếu muốn học hỏi thêm.

Bài đã được tự động gộp: 24/11/18

VetMini đã viết:
1. code dở ở chỗ này:

Với đoạn code này:

For i = 1 To UBound(mang, 1)
For j = 7 To 17
ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)

Bạn đã ReDim Preserve mang tất cả 11*4995 lần
Trong khi chỉ cần 1 lần đã đạt kết quả

ReDim Preserve mang(1 To UBound(mang, 1), 1 To 17)
For i = 1 To UBound(mang, 1)
For j = 7 To 17

2. dữ liệu bị mất vì lý do này:

For i = 1 To UBound(mang, 1)
' khi i = 1, vòng lặp kế tiếp chép dữ liệu vào cột 7 đến 17 của dòng 1
For j = 7 To 17
ReDim Preserve mang(1 To UBound(mang, 1), 1 To j)
' khi i = 2, và j = 7, lệnh trên đặt lại số cột là 7 cho nên nó xoá cột 8-17 của dòng 1
' khi i = 3, và j = 7, lệnh trên xoá cột 8-17 của dòng 1 và 2
' tức là cứ mỗi lượt thì dòng trước bị xoá.

Vậy em hơi hiểu về cái Redim Preserve rồi. Nhờ anh chỉ dẫn em đã hoàn thiện lại code chạy cho kết quả đúng và nhanh không tưởng so với lúc trước vừa thiếu vừa lâu. Chắc là do nguyên nhân anh bảo "Bạn đã ReDim Preserve mang tất cả 11*4995 lần"

Cảm ơn anh nhé, em chúc anh ngày cuối tuần vui vẻ!

PHP:

Sub Xep_hang_CaNhan_2018()
With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
End With
With Sheets("Data")
    Dim mang, mangPhu
    Dim soCot As Long, soDong As Long, i As Long, j As Long
    Dim rg1 As Range, rg2 As Range
    mang = .Range("B6:F5000").Value2
    mangPhu = .Range("FE6:FO5000").Value2
    ReDim Preserve mang(1 To UBound(mang, 1), 1 To 16)
    For i = 1 To UBound(mang, 1)
      For j = 6 To 16
        mang(i, j) = mangPhu(i, j - 5)
      Next j
    Next i
End With
Sheets("cham chi").Range("V5").Resize(UBound(mang, 1), UBound(mang, 2)) = mang
With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
End With
End Sub

VetMini · 24/11/18

Cách bạn diễn đạt code khó hiểu bỏ xừ.

Mã:

Dim soCot1 As Integer, soCot2 As Integer
    mang = .Range("B6:F5000").Value2
    mangPhu = .Range("FE6:FO5000").Value2
    soCot1 = UBound(mang,2)
    soCot2 = UBound(mangPhu,2)
    ReDim Preserve mang(1 To UBound(mang, 1), 1 To soCot1 + soCot2)
    For i = 1 To UBound(mang, 1)
      For j = 1 To soCot2
        mang(i, soCot1 + j) = mangPhu(i, j)
      Next j
    Next i

tueyennhi · 26/11/18

VetMini đã viết:

Cách bạn diễn đạt code khó hiểu bỏ xừ.

Mã:

Dim soCot1 As Integer, soCot2 As Integer
    mang = .Range("B6:F5000").Value2
    mangPhu = .Range("FE6:FO5000").Value2
    soCot1 = UBound(mang,2)
    soCot2 = UBound(mangPhu,2)
    ReDim Preserve mang(1 To UBound(mang, 1), 1 To soCot1 + soCot2)
    For i = 1 To UBound(mang, 1)
      For j = 1 To soCot2
        mang(i, soCot1 + j) = mangPhu(i, j)
      Next j
    Next i

Cảm ơn anh. Cách của anh linh hoạt hơn của em khi cơi nới mảng.

keke355992 · 3/12/18

Chào mọi người, Mình có 10 mảng, khai báo từ sArr1 - sArr10, cấu trúc mảng như nhau, và mục đích dùng "Scripting.Dictionary" để lấy giá trị duy nhất của cả 10 mảng

Mã:

sArr1 = Sheets("B1").Range("K5", Sheets("B1").Range("K99999").End(xlUp)).Resize(, 3).Value
sArr2 = Sheets("B2").Range("K5", Sheets("B2").Range("K99999").End(xlUp)).Resize(, 3).Value
.... Cho den sArr10
và đoạn code sau:

For i = 1 To UBound(sArr1)
            Tem = sArr1(i, 1) & "MAO" & sArr1(i, 2) '& "MAO" & sArr1(i, 3)
            If sArr1(i, 2) <> "" Then
                If Not dic.exists(Tem) Then
                    dic.Add Tem, sArr1(i, 3)
                End If
            End If
        Next i

Vậy có cách nào để không phải viết lại 10 lần vòng lặp này (Thay thành sArr2, sArr3....) ko vậy. Xin cảm ơn mọi người !

snow25 · 3/12/18

keke355992 đã viết:
Chào mọi người, Mình có 10 mảng, khai báo từ sArr1 - sArr10, cấu trúc mảng như nhau, và mục đích dùng "Scripting.Dictionary" để lấy giá trị duy nhất của cả 10 mảng

Mã:

sArr1 = Sheets("B1").Range("K5", Sheets("B1").Range("K99999").End(xlUp)).Resize(, 3).Value sArr2 = Sheets("B2").Range("K5", Sheets("B2").Range("K99999").End(xlUp)).Resize(, 3).Value .... Cho den sArr10 và đoạn code sau: For i = 1 To UBound(sArr1) Tem = sArr1(i, 1) & "MAO" & sArr1(i, 2) '& "MAO" & sArr1(i, 3) If sArr1(i, 2) <> "" Then If Not dic.exists(Tem) Then dic.Add Tem, sArr1(i, 3) End If End If Next i

Vậy có cách nào để không phải viết lại 10 lần vòng lặp này (Thay thành sArr2, sArr3....) ko vậy. Xin cảm ơn mọi người !

Vậy bạn cho 10 cái đó nó chạy vào vòng lặp là được.Hoặc bạn có thể cho vòng lặp nó chạy khi duyệt qua các sheets cũng được.

HieuCD · 3/12/18

keke355992 đã viết:
Chào mọi người, Mình có 10 mảng, khai báo từ sArr1 - sArr10, cấu trúc mảng như nhau, và mục đích dùng "Scripting.Dictionary" để lấy giá trị duy nhất của cả 10 mảng

Mã:

sArr1 = Sheets("B1").Range("K5", Sheets("B1").Range("K99999").End(xlUp)).Resize(, 3).Value sArr2 = Sheets("B2").Range("K5", Sheets("B2").Range("K99999").End(xlUp)).Resize(, 3).Value .... Cho den sArr10 và đoạn code sau: For i = 1 To UBound(sArr1) Tem = sArr1(i, 1) & "MAO" & sArr1(i, 2) '& "MAO" & sArr1(i, 3) If sArr1(i, 2) <> "" Then If Not dic.exists(Tem) Then dic.Add Tem, sArr1(i, 3) End If End If Next i

Vậy có cách nào để không phải viết lại 10 lần vòng lặp này (Thay thành sArr2, sArr3....) ko vậy. Xin cảm ơn mọi người !

Tạo mảng sArr=array(sArr1,sArr2,...,sArr10)
for n=0 to ubound(sarr)
For i = 1 To UBound(sArr(n))
Tem = sArr(n)(i, 1)....
......
next i
next n

keke355992 · 3/12/18

snow25 đã viết:
Vậy bạn cho 10 cái đó nó chạy vào vòng lặp là được.Hoặc bạn có thể cho vòng lặp nó chạy khi duyệt qua các sheets cũng được.

HieuCD đã viết:
Tạo mảng sArr=array(sArr1,sArr2,...,sArr10)
for n=0 to ubound(sarr)
For i = 1 To UBound(sArr(n))
Tem = sArr(n)(i, 1)....
......
next i
next n

Cảm ơn 2 bạn nhé !

batman1 · 3/12/18

keke355992 đã viết:
Cảm ơn 2 bạn nhé !

Nhưng tạo 10 mảng làm gì khi ở mỗi thời điểm chỉ dùng 1 mảng?

Ngoài ra code không xử lý trường hợp khi ô cuối cùng ở cột K nằm ở dòng < 5. Lúc đó cũng cho vd. K4 & "MAO" & L4 vào đít to?

Tham khảo (tôi viết chay vì lười tạo dữ liệu để test)

Mã:

Sub test()
Dim lastRow As Long, k As Long, r As Long, Arr(), tem As String, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    For k = 1 To 10
        With ThisWorkbook.Worksheets("B" & k)
            lastRow = .Cells(Rows.Count, "K").End(xlUp).Row
            If lastRow >= 5 Then
                Arr = .Range("K5:K" & lastRow).Resize(, 3).Value
                For r = 1 To UBound(Arr)
                    If Len(Arr(r, 2)) Then
                        tem = Arr(r, 1) & "MAO" & Arr(r, 2)
                        If Not dic.exists(tem) Then dic.Add tem, Arr(r, 3)
                    End If
                Next r
            End If
        End With
    Next k
'    lam gi do voi dic
'    ...
    Set dic = Nothing
End Sub

keke355992 · 3/12/18

batman1 đã viết:
Nhưng tạo 10 mảng làm gì khi ở mỗi thời điểm chỉ dùng 1 mảng?

Ngoài ra code không xử lý trường hợp khi ô cuối cùng ở cột K nằm ở dòng < 5. Lúc đó cũng cho vd. K4 & "MAO" & L4 vào đít to?

Tham khảo (tôi viết chay vì lười tạo dữ liệu để test)

Mã:

Sub test() Dim lastRow As Long, k As Long, r As Long, Arr(), tem As String, dic As Object Set dic = CreateObject("Scripting.Dictionary") For k = 1 To 10 With ThisWorkbook.Worksheets("B" & k) lastRow = .Cells(Rows.Count, "K").End(xlUp).Row If lastRow >= 5 Then Arr = .Range("K5:K" & lastRow).Resize(, 3).Value For r = 1 To UBound(Arr) If Len(Arr(r, 2)) Then tem = Arr(r, 1) & "MAO" & Arr(r, 2) If Not dic.exists(tem) Then dic.Add tem, Arr(r, 3) End If Next r End If End With Next k ' lam gi do voi dic ' ... Set dic = Nothing End Sub

Cám ơn bạn nhé, theo hướng dẫn của bạn mình viết được code gọn hơn nhiều rồi

Hoàng Nhật Phương · 31/12/18

Xin chào các bạn,
Oanh Thơ (OT) đang sử dụng sub CompareWorksheets, với mục đích so sánh dữ liệu của 2 bảng tính tìm ra những ô khác nhau và ghi lại kết quả khác nhau ra một sheet khác:

Mã:

Public Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
    Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
    Dim DiffCount As Long, r As Long, c As Integer
    lr1 = ws1.UsedRange.Rows.count:                 lc1 = ws1.UsedRange.Columns.count
    lr2 = ws2.UsedRange.Rows.count:                 lc2 = ws2.UsedRange.Columns.count
    maxR = lr1:                                     maxC = lc1
    If maxR < lr2 Then maxR = lr2:                  If maxC < lc2 Then maxC = lc2
    DiffCount = 0
    For c = 1 To maxC
        Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
        For r = 1 To maxR
            cf1 = "":   cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(r, c).FormulaLocal:     cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                Worksheets(2).Cells(r, c).Formula = " " & cf1 & " <> " & cf2
            End If
        Next r
    Next c
    Application.StatusBar = False
    Debug.Print DiffCount & " So cell khac nhau ", vbInformation, "cua " & ws1.name & " with " & ws2.name
End Sub

OT muốn chuyển sang mảng nhưng loay hoay một hồi chưa biết cách, nhờ các bạn giúp đỡ ạ.

PacificPR · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào các bạn,
Oanh Thơ (OT) đang sử dụng sub CompareWorksheets, với mục đích so sánh dữ liệu của 2 bảng tính tìm ra những ô khác nhau và ghi lại kết quả khác nhau ra một sheet khác:

Mã:

Public Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
    Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
    Dim DiffCount As Long, r As Long, c As Integer
    lr1 = ws1.UsedRange.Rows.count:                 lc1 = ws1.UsedRange.Columns.count
    lr2 = ws2.UsedRange.Rows.count:                 lc2 = ws2.UsedRange.Columns.count
    maxR = lr1:                                     maxC = lc1
    If maxR < lr2 Then maxR = lr2:                  If maxC < lc2 Then maxC = lc2
    DiffCount = 0
    For c = 1 To maxC
        Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
        For r = 1 To maxR
            cf1 = "":   cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(r, c).FormulaLocal:     cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                Worksheets(2).Cells(r, c).Formula = " " & cf1 & " <> " & cf2
            End If
        Next r
    Next c
    Application.StatusBar = False
    Debug.Print DiffCount & " So cell khac nhau ", vbInformation, "cua " & ws1.name & " with " & ws2.name
End Sub

OT muốn chuyển sang mảng nhưng loay hoay một hồi chưa biết cách, nhờ các bạn giúp đỡ ạ.

Đề nghị Chị đẹp đẹp đính kèm file cho mọi người dễ hình dung

Hoàng Nhật Phương · 31/12/18

PacificPR đã viết:
Đề nghị Chị đẹp đẹp đính kèm file cho mọi người dễ hình dung

Cảm ơn bạn đã quan tâm ạ, OT gửi bạn file kèm.
Nhờ bạn và mọi người xem giúp.

tam888 · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã quan tâm ạ, OT gửi bạn file kèm.
Nhờ bạn và mọi người xem giúp.

Dữ liệu có gì so sánh đâu nhỉ, toàn thấy chữ data và linh tinh gì đó
Có post nhầm file không?

Quang_Hải · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã quan tâm ạ, OT gửi bạn file kèm.
Nhờ bạn và mọi người xem giúp.

Bài này có thể lấy 2 mảng dữ liệu rồi chạy 2 vòng For Next để so sánh. Không biết mình có hiểu sai hay không nhưng thấy cũng đơn giản mà. Bạn nhặt ở đâu cái đoạn code cao cấp quá vậy.
Chỉ cần so sánh

If sArr1(i,j) <> sArr2(i,j) Then
KQ(i,j)= "ABC"
End If

To tam888:

Chị này là vậy đó. Mấy anh chị mới học code thường vậy đó. Mình quen rồi nên nhìn là hiểu chị ấy muốn gì rồi

tam888 · 31/12/18

quanghai1969 đã viết:
Bài này có thể lấy 2 mảng dữ liệu rồi chạy 2 vòng For Next để so sánh. Không biết mình có hiểu sai hay không nhưng thấy cũng đơn giản mà. Bạn nhặt ở đâu cái đoạn code cao cấp quá vậy.
Chỉ cần so sánh

If sArr1(i,j) <> sArr2(i,j) Then
KQ(i,j)= "ABC"
End If

To tam888:

Chị này là vậy đó. Mấy anh chị mới học code thường vậy đó. Mình quen rồi nên nhìn là hiểu chị ấy muốn gì rồi

Học thì học, dữ liệu phải chỉnh chu, ví dụ thì phải như thật
Còn kiểu ẩu ẩu thế tự viết code, thử cũng dễ nhầm và sai... lại mất công hỏi lại

Hoàng Nhật Phương · 31/12/18

tam888 đã viết:
Dữ liệu có gì so sánh đâu nhỉ, toàn thấy chữ data và linh tinh gì đó
Có post nhầm file không?

Xin chào tam888, cảm ơn bạn đã quan tâm.
Dạ mục đích để minh họa cho thấy được sự thay đổi dữ liệu giữa 2sheet thôi ạ, nên dữ liệu là gì hay mẫu ra sao cũng không quan trọng ạ.

quanghai1969 đã viết:
Bài này có thể lấy 2 mảng dữ liệu rồi chạy 2 vòng For Next để so sánh. Không biết mình có hiểu sai hay không nhưng thấy cũng đơn giản mà. Bạn nhặt ở đâu cái đoạn code cao cấp quá vậy.
Chỉ cần so sánh

If sArr1(i,j) <> sArr2(i,j) Then
KQ(i,j)= "ABC"
End If

To tam888:

Chị này là vậy đó. Mấy anh chị mới học code thường vậy đó. Mình quen rồi nên nhìn là hiểu chị ấy muốn gì rồi

Dạ, OT xin cảm ơn anh quanghai1969 đã hỗ trợ

Anh quanghai1969 code lại cả đoạn trên với cách dùng mảng giúp OT với ạ.
OT nhặt nó ở đây ạ:
http://www.tuvantinhoc1088.com/excel/so-sanh-hai-worksheet-bang-vba-trong-microsoft-excel-13680
Xin lỗi BQT nếu OT có đưa sai link không đúng nội quy ạ.

tam888 · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tam888, cảm ơn bạn đã quan tâm.
Dạ mục đích để minh họa cho thấy được sự thay đổi dữ liệu giữa 2sheet thôi ạ, nên dữ liệu là gì hay mẫu ra sao cũng không quan trọng ạ.
.

Xem lại bài #1,081 trên
Gặp dữ liệu kiểu này mọi người nản thường bỏ qua
Vì học mà giả lập dữ liệu ẩu, thì test sẽ ẩu thôi, đôi khi tưởng đúng mà không đúng
Ví dụ dữ liệu toàn cell có giá trị giống nhau vậy (chứa "data") thì thuật toán đơn giản hơn nhiều so với các ô (cells) có giá trị ngẫu nhiên khác nhau --> vậy khi xem file giả lập đại thế người ta sẽ định dữ liệu thế nào mà lượng ra thuật toán đây???, theo cái giống hệt nhau thế thì lúc thật lại sai
Chưa kể chính bạn test cũng dễ sai

Hoàng Nhật Phương · 31/12/18

tam888 đã viết:
Xem lại bài #1,081 trên
Gặp dữ liệu kiểu này mọi người nản thường bỏ qua
Vì học mà giả lập dữ liệu ẩu, thì test sẽ ẩu thôi, đôi khi tưởng đúng mà không đúng
Ví dụ dữ liệu toàn cell có giá trị giống nhau vậy (chứa "data") thì thuật toán đơn giản hơn nhiều so với các ô (cells) có giá trị ngẫu nhiên khác nhau

Dạ vâng, OT xin lưu ý lần sau sẽ minh họa kiểu dữ liệu tổng quát và đa dạng hơn ạ.
Cảm ơn bạn nhiều.

Ba Tê · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Dạ, OT xin cảm ơn anh quanghai1969 đã hỗ trợ
Anh quanghai1969 code lại cả đoạn trên với cách dùng mảng giúp OT với ạ.

Anh Quang Hải sẽ viết giống giống vầy:

PHP:

Public Sub SoSanh()
Dim Arr1(), Arr2(), Arr3()
Dim I As Long, J As Long, R As Long, Col As Long
Arr1 = Sheet1.Range("A1:N51").Value
Arr2 = Sheet2.Range("A1:N51").Value
R = UBound(Arr1): Col = UBound(Arr1, 2)
ReDim Arr3(1 To R, 1 To Col)
For I = 1 To R
    For J = 1 To Col
        If Arr1(I, J) <> Arr2(I, J) Then Arr3(I, J) = Arr1(I, J) & "<>" & Arr2(I, J)
    Next J
Next I
Sheet3.Range("A1").Resize(R, Col) = Arr3
End Sub

Hoàng Nhật Phương · 31/12/18

Ba Tê đã viết:

Anh Quang Hải sẽ viết giống giống vầy:

PHP:

Public Sub SoSanh()
Dim Arr1(), Arr2(), Arr3()
Dim I As Long, J As Long, R As Long, Col As Long
Arr1 = Sheet1.Range("A1:N51").Value
Arr2 = Sheet2.Range("A1:N51").Value
R = UBound(Arr1): Col = UBound(Arr1, 2)
ReDim Arr3(1 To R, 1 To Col)
For I = 1 To R
    For J = 1 To Col
        If Arr1(I, J) <> Arr2(I, J) Then Arr3(I, J) = Arr1(I, J) & "<>" & Arr2(I, J)
    Next J
Next I
Sheet3.Range("A1").Resize(R, Col) = Arr3
End Sub

Lợi hại quá thầy ơi, con cảm ơn thầy nhiều ạ.
Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được.
Thật đơn giản mà hiệu quả,chắc chắn anh Quang Hải sẽ viết giống thầy rồi.Con nhớ ở bài viết nào đó anh Quanh Hải đã từng bị hỏi không kịp trở tay nên đã đọc thần chú "anh Ba Tê ơiii" ạ

befaint · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được.

Range.Value thì nhất định là Value (và chưa chắc là Text - nội dung hiển thị đã qua Format Cells).

Range.Text thì nhất định là Text (và có thể là Value).

Gọi tới thuộc tính Text của Range thì Range chỉ là một Cell, không thể gọi tới thuộc tính Text của nhiều Cells.

Ví dụ:

PHP:

Sub Text_cua_mot_Cell()
msgbox Range("A1").Text
End Sub

PHP:

Sub Text_cua_hai_Cell()
'// Như thế này sẽ lỗi.
msgbox Range("A1:A2").Text
End Sub

Đọc thêm mục 3.1 ở bài này: https://www.giaiphapexcel.com/diendan/threads/bài-6-range-cells.130603/

Hoàng Nhật Phương · 31/12/18

befaint đã viết:
Range.Value thì nhất định là Value (và chưa chắc là Text - nội dung hiển thị đã qua Format Cells).

Range.Text thì nhất định là Text (và có thể là Value).

Gọi tới thuộc tính Text của Range thì Range chỉ là một Cell, không thể gọi tới thuộc tính Text của nhiều Cells.

Ví dụ:

PHP:

Sub Text_cua_mot_Cell() msgbox Range("A1").Text End Sub

PHP:

Sub Text_cua_hai_Cell() '// Như thế này sẽ lỗi. msgbox Range("A1:A2").Text End Sub

Đọc thêm mục 3.1 ở bài này: https://www.giaiphapexcel.com/diendan/threads/bài-6-range-cells.130603/

Cảm ơn befaint,OT thử thí nghiệm:
gõ số 1 vào một ô ví dụ G7 trong sheet1 với định dạng qua Format Cells là "General"
và gõ số 1 vào một ô G7 trong sheet2 với định dạng qua Format Cells là "@"
Kết quả code ở bài #1078 , không nhận đạng được sự khác nhau.
Nhưng code ở bài #1085 của thầy BaTê thì nhận dạng được sự khác nhau này ạ.

OT cũng thử kiểm tra theo gợi ý của befaint:

Range.Value thì nhất định là Value (và chưa chắc là Text - nội dung hiển thị đã qua Format Cells)

Mã:

Sub test()
    If Sheet1.Range("G7").Value = Sheet2.Range("G7").Value Then
        Sheet3.Range("G7").Value = True
    Else
        Sheet3.Range("G7").Value = False
    End If
End Sub

OT đang hiểu value là số (có thể tính toán được) còn text là dạng chuỗi (không thể tính toán được).
Hiểu như vậy có phải vậy có sai lầm không vậy befaint? Nếu không phiền nhờ bạn giải thích giúp OT thêm một chút nữa ạ.
Cảm ơn befaint.

befaint · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
OT đang hiểu value là số (có thể tính toán được) còn text là dạng chuỗi (không thể tính toán được).
Hiểu như vậy có phải vậy có sai lầm không vậy befaint? Nếu không phiền nhờ bạn giải thích giúp OT thêm một chút nữa ạ.

Mình không bàn luận các bài giải trên, mà chỉ trích dẫn một phần bài của bạn và nêu lý thuyết.
Tức là, bạn đã nêu "Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được."
Rồi mình xem code ở bài trên có

Mã:

Arr1=Range.Value
Arr2=Range.Value

đều gọi tới thuộc tính Value của Range, chứ không hề xét thuộc tính Text của Range nên mình nêu lý thuyết để bạn phân biệt được:
- Định dạng (tức là có Format Cells).
- Value
- Text
---------
"value là số (có thể tính toán được) "
Value là Value (dịch ra là giá trị), có thể là number, có thể là string. Number thì mới có thể tính toán +-*/, string thì không tính toán +-*/ được.

Giờ xét một Cell. Nội dung ta nhìn thấy trên Cell (ở bảng tính) có thể:
- nhập từ bàn phím, hay được sao chép ở nguồn khác vào;
- kết quả của công thức nào đó trong Cell đó;
- định dạng đối với Cell đó.
Rồi ta xét hai thuộc tính .Value và .Text của một Cell kia xem chúng khác nhau thế nào (xem ví dụ ở 3.1 đã dẫn ở bài trước).

=> Túm lại để bạn nắm được lý thuyết và gọi tên đúng thôi (chỗ chữ màu đỏ).

Hoàng Nhật Phương · 31/12/18

befaint đã viết:
Mình không bàn luận các bài giải trên, mà chỉ trích dẫn một phần bài của bạn và nêu lý thuyết.
Tức là, bạn đã nêu "Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được."
Rồi mình xem code ở bài trên có

Mã:

Arr1=Range.Value Arr2=Range.Value

đều gọi tới thuộc tính Value của Range, chứ không hề xét thuộc tính Text của Range nên mình nêu lý thuyết để bạn phân biệt được:
- Định dạng (tức là có Format Cells).
- Value
- Text
---------
"value là số (có thể tính toán được) "
Value là Value (dịch ra là giá trị), có thể là number, có thể là string. Number thì mới có thể tính toán +-*/, string thì không tính toán +-*/ được.

Giờ xét một Cell. Nội dung ta nhìn thấy trên Cell (ở bảng tính) có thể:
- nhập từ bàn phím, hay được sao chép ở nguồn khác vào;
- kết quả của công thức nào đó trong Cell đó;
- định dạng đối với Cell đó.
Rồi ta xét hai thuộc tính .Value và .Text của một Cell kia xem chúng khác nhau thế nào (xem ví dụ ở 3.1 đã dẫn ở bài trước).

=> Túm lại để bạn nắm được lý thuyết và gọi tên đúng thôi (chỗ chữ màu đỏ).

Cảm ơn befaint rất nhiều, OT đã hiểu ạ.
Sau một thời gian bọn trẻ thi học kỳ I. OT không nghĩ gì đến code, giờ lại bắt đầu thấy mông lung.Thi thoảng OT vẫn tìm đến các bài viết về vba của bạn để đọc. Hic mỗi lần tìm cũng hơi mất chút thời gian, sao không thấy BQT không ghim lại các bài viết tổng hợp của bạn lại để mọi người có thể tiện xem nhỉ.
Cũng may GPE còn có rất nhiều người sẵn sàng có thể chỉ dẫn tận tình như bạn.
Chúc bạn một mùa đông ấm áp.

HeSanbi · 1/1/19

@Nguyễn Hoàng Oanh Thơ
"Phụ nữ học VBA thì ai sẽ nội trợ"

Góp phần cho đàn ông thành "bà nội trợ":
Học VBA "siêu tốc hành" 1 , 2 , 3 , 4 ( Suy nghĩ lại chưa muộn )

Phụ nữ nên học VBA viết công thức "Nấu ăn ngon"

batman1 · 1/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Lợi hại quá thầy ơi, con cảm ơn thầy nhiều ạ.
Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được.

Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

so sánh dữ liệu của 2 bảng tính tìm ra những ô khác nhau

Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết

Code trước không so sánh được định dạng (value và text), nhưng code của thầy có thể phân biệt so sánh được.

Bây giờ ta xét trường hợp:
- sheet1: A1 = 5
- sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.

ptm0412 · 1/1/19

batman1 đã viết:
Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.

Đúng là chưa thấu đáo anh ạ, bạn ấy đang học

Hoàng Nhật Phương · 1/1/19

batman1 đã viết:
Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết

Bây giờ ta xét trường hợp:
- sheet1: A1 = 5
- sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.

Con chào bác Siwtom,
Dạ vâng, đúng là ngay từ đầu khi đưa code lên con chỉ nghĩ đến việc chuyển code đó sang mảng sẽ nhanh hơn,mà không nghĩ đến việc code đó phân tích cụ thể về các trường hợp khác nhau như thế nào, sau khi được thầy Ba Tê giúp đỡ con mới thử tò mò so sánh kiểm tra các trường hợp, đúng là con chưa thử trường hợp này:

Bây giờ ta xét trường hợp:
- sheet1: A1 = 5
- sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2
Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi.

Sau khi con thử nghiệm thấy đúng thế ạ,híc cách nào cũng có ưu điểm và nhược điểm,tùy thuộc vào kiểu dữ liệu để áp dụng dùng trường hợp nào,nếu dữ liệu không có công thức thì dùng theo cách của thầy Ba Tê đưa hết vào mảng để so sánh, dùng mảng tốc độ sẽ nhanh phân biệt được text và number, còn với code con đưa lên sử dụng FormulaLocal so sánh được ô chứa công thức nhưng cũng không so sánh được với ô có Format Cells khác nhau (như ví dụ con đã đưa)...
Và con vừa mới tham khảo thêm ở đây để hiểu thêm nhưng dường như chủ đề cũng chưa đi đến kết quả cuối cùng:
https://www.giaiphapexcel.com/diendan/threads/so-sánh-2-range-giúp-mình-với.1716/

Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

Trước đó khi được bạn @befaint hỗ trợ phân tích,con cũng định hỏi bạn ấy về thuộc tính FormulaLocal nhưng con nghĩ có lẽ con sẽ không dùng đến nên con đã không hỏi.

Con cảm ơn bác,
Chúc bác một năm tới sức khỏe ạ.

Hoàng Nhật Phương · 1/1/19

HeSanbi đã viết:
@Nguyễn Hoàng Oanh Thơ
"Phụ nữ học VBA thì ai sẽ nội trợ"

Góp phần cho đàn ông thành "bà nội trợ":
Học VBA "siêu tốc hành" 1 , 2 , 3 , 4 ( Suy nghĩ lại chưa muộn )

Phụ nữ nên học VBA viết công thức "Nấu ăn ngon"

Cảm ơn HeSanbi,
Công việc của OT nếu không có sự trợ giúp của GPE thì không biết đến giờ sẽ kinh khủng như thế nào ạ.
Học VBA thì mới có thời gian để nội trợ ạ (không phải ôm việc về nhà làm)

ptm0412 đã viết:
Đúng là chưa thấu đáo anh ạ, bạn ấy đang học

Cháu cảm ơn chú Mỹ đã nói đỡ, đúng là do cháu suy nghĩ chưa thấu đáo. Cháu cũng đọc nhiều bài viết về vba và các tài liệu của chú, nhưng hình như đã lâu rồi chú không viết bài ạ?

ptm0412 · 1/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Cháu cảm ơn chú Mỹ đã nói đỡ, đúng là do cháu suy nghĩ chưa thấu đáo. Cháu cũng đọc nhiều bài viết về vba và các tài liệu của chú, nhưng hình như đã lâu rồi chú không viết bài ạ?

Độ rày tôi cũng bận rộn quá, nhưng vẫn theo dõi diễn đàn và biết rằng GPE bây giờ nhiều người giỏi (nhiều hơn xưa) (befaint chẳng hạn).
Nói nhỏ:
Trừ con ếch xanh, code ào ào mà lý luận không đủ cơ sở, tính logic không đủ, căn bản không đạt
Bác Sa_DQ thì code vững nhưng ít giải thích và phân tích
TB:
- Mà bạn đọc bài số 1089 của befaint rồi mà vẫn còn nói "text và value" và "định dạng" theo cách của bạn?
- Topic nào của befaint mà bạn muốn "dán lên", cho tôi cái link tôi làm ngay.

Hoàng Nhật Phương · 1/1/19

ptm0412 đã viết:
Độ rày tôi cũng bận rộn quá, nhưng vẫn theo dõi diễn đàn và biết rằng GPE bây giờ nhiều người giỏi (nhiều hơn xưa) (befaint chẳng hạn).
Nói nhỏ:
Trừ con ếch xanh, code ào ào mà lý luận không đủ cơ sở, tính logic không đủ, căn bản không đạt
Bác Sa_DQ thì code vững nhưng ít giải thích và phân tích
TB:
- Mà bạn đọc bài số 1089 của befaint rồi mà vẫn còn nói "text và value" và "định dạng" theo cách của bạn?
- Topic nào của befaint mà bạn muốn "dán lên", cho tôi cái link tôi làm ngay.

Xin chào chú ptm0412,
Cháu cảm ơn chú Mỹ đã thông tin lại ạ, GPE đúng là rất tuyệt vời ạ (rất nhiều người giỏi và tận tình ạ).

- Mà bạn đọc bài số 1089 của befaint rồi mà vẫn còn nói "text và value" và "định dạng" theo cách của bạn?

Híc, đúng là cháu có đọc và hiểu nhưng do thói quen nên cháu chưa sửa được, cháu đã sửa lại và bôi đỏ chỗ đó ạ.

- Topic nào của befaint mà bạn muốn "dán lên", cho tôi cái link tôi làm ngay.

Nếu có thể được nhờ chú Mỹ giúp cháu ghim bài viết này trong box lập trình để khi cần cháu và những người như cháu có thể tìm thấy ngay được ạ.
https://www.giaiphapexcel.com/diendan/threads/index-các-bài-viết-về-vba.129388/#post-811415

Cháu cảm ơn chú Mỹ nhiều ạ
Chúc những ngày nghỉ lễ vui khỏe ạ.
Oanh Thơ

ptm0412 · 1/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào chú ptm0412,
Nếu có thể được nhờ chú Mỹ giúp cháu ghim bài viết này trong box lập trình với ạ.
https://www.giaiphapexcel.com/diendan/threads/index-các-bài-viết-về-vba.129388/#post-811415
Oanh Thơ

Đã xong

Hoàng Nhật Phương · 1/1/19

ptm0412 đã viết:
Đã xong

Ahihi cháu đã thấy, xin cảm ơn chú Mỹ nhiều ạ.

ptm0412 · 1/1/19

Nói về text, value, format, formula thì nên tự tìm hiểu, sau đây là 1 cách tự tìm hiểu:

VetMini · 1/1/19

Nhắc nhở cho cái cô bé kia kẻo lỡ cơ hội.
Vấn đề mảng nói chung, và mảng nhiều chiều nói riêng, ở đây KHÔNG CÓ ai giỏi bằng bác ấy. Lời nhận định này không có ngoại lệ, tức là kể cả tôi cũng nhường bác ấy.

Cô bé phải nhân cơ hội này mà hỏi bác ấy cách duyệt mảng 2 chiều. Và nhờ bác ấy giải thích.

Chú: đối với tôi thì viết code rõ, dễ đọc mới là tối ưu. Nhưng đối với các bạn, tốc độ mới quan trọng. Duyệt mảng có cách tốc độ ưu việt hơn cách khác khi ta hiểu rõ cấu trúc của nó.

Hoàng Nhật Phương · 1/1/19

Dạ, cháu cảm ơn chú Mỹ đã chỉ dẫn để cháu hiểu thêm về bản chất các thuộc tính của range ạ.
Cháu cảm ơn bác VetMini đã chỉ đường ạ, cháu cũng thường hỏi bác ấy nhiều,nhưng đầu óc cháu hay quên và tư duy kém linh hoạt nên mới hay hỏi ạ...vâng, khi có cơ hội cháu sẽ cố gắng hỏi bác ấy nhiều hơn nữa ạ.
Thực sự vấn đề này cháu chưa biết và hình dung được bác ạ:

... phải nhân cơ hội này mà hỏi bác ấy cách duyệt mảng 2 chiều.Và nhờ bác ấy giải thích...

Híc... T_T

tam888 · 1/1/19

batman1 đã viết:
Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết

Bây giờ ta xét trường hợp:
- sheet1: A1 = 5
- sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.

Có gì mà lạ bác, mọi người toàn vội vàng sống gấp, suy nghĩ nhanh, code cũng muốn code nhanh dù chẳng hơn nhau mấy % giây (tức là hiệu quả gần như bằng 0)
File dữ liệu người hỏi thì ẩu từ cách làm file data - thì kết quả sẽ đa dạng thôi.

VetMini · 1/1/19

tam888 đã viết:
Có gì mà lạ bác, mọi người toàn vội vàng sống gấp, suy nghĩ nhanh, code cũng muốn code nhanh dù chẳng hơn nhau mấy % giây (tức là hiệu quả gần như bằng 0)
...

Tôi không tin lắm.
Theo tôi thì chỉ vì một vài vị có máu mặt trong diễn đàn này chú trọng "tốc độ chạy của code" cho nên những người học code theo họ cứ nghĩ rằng đấy là chân lý của lập trình ứng dụng.
Đọc bài quen ở đây sẽ thấy "trường phái GPE" sắp hạng những điều được coi là "tối ưu code":
1. tốc độ chạy
2. số dòng code
3. số vòng lặp

Hoàng Nhật Phương · 7/1/19

Xin chào các bạn,
Oanh Thơ đang sử dụng hàm "RemoveDupesDict" để xóa các các dữ liệu trùng:

Mã:

Function RemoveDupesDict(MyArray As Variant) As Variant
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray) To UBound(MyArray)
            If IsMissing(MyArray(i)) = False Then
                .Item(MyArray(i)) = 1
            End If
        Next
        RemoveDupesDict = .Keys
    End With
End Function

Và 1 sub Test_RemoveDupesDict

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
  
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(Application.Transpose(Application.Transpose(arr1)))
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
  
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(Application.Transpose(arr1))
    sh.Range("B4").Resize(UBound(arr2)) = arr2

End Sub

Nhờ các bạn sửa giúp hàm "RemoveDupesDict" để không phải sử dụng đến các hàm hỗ trợ "Application.Transpose", kết quả mong muốn hàm sau khi sửa sẽ viết như sau:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
  
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
  
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)+1) = arr2

    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("I6").Resize(UBound(arr2)+1, 2) = arr2
End Sub

snow25 · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào các bạn,
Oanh Thơ đang sử dụng hàm "RemoveDupesDict" để xóa các các dữ liệu trùng:

Mã:

Function RemoveDupesDict(MyArray As Variant) As Variant
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray) To UBound(MyArray)
            If IsMissing(MyArray(i)) = False Then
                .Item(MyArray(i)) = 1
            End If
        Next
        RemoveDupesDict = .Keys
    End With
End Function

Và 1 sub Test_RemoveDupesDict

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
 
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(Application.Transpose(Application.Transpose(arr1)))
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
 
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(Application.Transpose(arr1))
    sh.Range("B4").Resize(UBound(arr2)) = arr2

End Sub

Nhờ các bạn sửa giúp hàm "RemoveDupesDict" để không phải sử dụng đến các hàm hỗ trợ "Application.Transpose", kết quả mong muốn hàm sau khi sửa sẽ viết như sau:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
 
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
 
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)+1) = arr2

    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("I6").Resize(UBound(arr2)+1, 2) = arr2
End Sub

View attachment 210577

Bạn dùng cái này xem.

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant
    Dim arr, a As Integer, j As Long
    ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
        RemoveDupesDict = arr
    End With
End Function

Hoàng Nhật Phương · 7/1/19

snow25 đã viết:

Bạn dùng cái này xem.

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant
    Dim arr, a As Integer, j As Long
    ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
        RemoveDupesDict = arr
    End With
End Function

Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3:    
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:

Mã:

    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.

PacificPR · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3: 
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:

Mã:

    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.

Cái hàm
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant và If Not .exists(MyArray(i, so)) Then vì vậy arr1 = sh.Range("A1:Q1").Value thì sh.Range("A2").Resize(, UBound(arr2)) = arr2 trả về kết quả là A1 là đúng rồi

Đáng nhẽ phải là UBound(arr2,2) chứ

Hoàng Nhật Phương · 7/1/19

PacificPR đã viết:
Cái hàm
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant và If Not .exists(MyArray(i, so)) Then vì vậy arr1 = sh.Range("A1:Q1").Value thì trả về kết quả là A1 là đúng rồi

PacificPR cho ý tưởng khắc phục đi ạ ^_^

PacificPR · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
PacificPR cho ý tưởng khắc phục đi ạ ^_^

Với mảng trên UBound(arr2) =1 mờ. Nếu mảng 1 hàng thì hàm trên trả nguyên về mảng ban đầu

VetMini · 7/1/19

Cái hàm RemoveDupesDict này lấy ở đâu ra vậy? Theo notes thì nó lấy của wellsr.com, có chính xác vậy không?

snow25 · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3:   
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:

Mã:

    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("a1:q1").Value
    arr2 = RemoveDupesDict(arr1, 1, 2)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
      Select Case dk
      Case 1
        ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
      Case 2
         ReDim arr(1 To UBound(MyArray, 2), 1 To UBound(MyArray, 1))
         For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a, 1) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next
      End Select
        RemoveDupesDict = arr
    End With
End Function

Bạn test cái này xem.

Hoàng Nhật Phương · 7/1/19

VetMini đã viết:
Cái hàm RemoveDupesDict này lấy ở đâu ra vậy? Theo notes thì nó lấy của wellsr.com, có chính xác vậy không?

Xin chào bác VetMini.
Dạ, cháu lấy ở đây bác ạ:
https://wellsr.com/vba/2017/excel/vba-remove-duplicates-from-array/

PacificPR đã viết:
Với mảng trên UBound(arr2) =1 mờ. Nếu mảng 1 hàng thì hàm trên trả nguyên về mảng ban đầu

OT Debug thấy đúng như vậy

, PacificPR sửa hàm RemoveDupesDict đi ạ.

VetMini · 7/1/19

Tôi đặt câu hỏi là vì từ "dupe" tiếng Anh có nghĩa là "gạt" (động) và "gã khờ" (danh).
Đang tìm hiểu xem tại sao tác giả lại chơi chữ lạ vậy.

Bổ sung:
Đã tìm ra rồi. "dupes" là âm đọc tắt của "dupplicates". (Chỉ là âm chứ không phải từ chính thức, cũng như cos là because)

Hoàng Nhật Phương · 7/1/19

snow25 đã viết:

Mã:

Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("a1:q1").Value
    arr2 = RemoveDupesDict(arr1, 1, 2)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
      Select Case dk
      Case 1
        ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
      Case 2
         ReDim arr(1 To UBound(MyArray, 2), 1 To UBound(MyArray, 1))
         For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a, 1) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next
      End Select
        RemoveDupesDict = arr
    End With
End Function

Bạn test cái này xem.

Cảm ơn snow25 nhiều ạ,
Bạn có thể sửa giúp OT trong trường hợp, nếu dk=2 khi muốn đưa các phần tử trong mảng vào 1 dòng , thì không phải sử dụng "Application.Transpose" nữa được không ạ:

Mã:

arr2 = RemoveDupesDict2(arr1, 1, 2)
    sh.Range("A2").Resize(, UBound(arr2)) = Application.Transpose(arr2)

Hoàng Nhật Phương · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn snow25 nhiều ạ,
Bạn có thể sửa giúp OT trong trường hợp, nếu dk=2 khi muốn đưa các phần tử trong mảng vào 1 dòng , thì không phải sử dụng "Application.Transpose" nữa được không ạ:

Mã:

arr2 = RemoveDupesDict2(arr1, 1, 2) sh.Range("A2").Resize(, UBound(arr2)) = Application.Transpose(arr2)

Hihi, loay hoay một lúc với cái Case 2 hình như OK rồi. Xin cảm ơn snow25 nhiều ạ.
OT gửi lại code, nếu có chỗ nào chưa tối ưu (có thể phát sinh lỗi) nhờ các bạn góp ý thêm ạ:

Mã:

Option Explicit

Sub Test_RemoveDupesDict_2()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict_2(arr1, 1, 2)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2

    
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict_2(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
    
'3:
    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict_2(arr1, 1)
    sh.Range("I6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
End Sub

Function RemoveDupesDict_2(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        Select Case dk
        Case 1
            ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
            For i = LBound(MyArray, 1) To UBound(MyArray, 1)
                If Not .exists(MyArray(i, so)) Then
                     a = a + 1
                     For j = 1 To UBound(MyArray, 2)
                         arr(a, j) = MyArray(i, j)
                     Next j
                    .Item(MyArray(i, so)) = 1
                End If
            Next i
        Case 2
        ReDim arr(1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next i
        End Select
        RemoveDupesDict_2 = arr
    End With
End Function

Hoàng Nhật Phương · 7/1/19

Xin chào snow25,
Bạn có thể giải thích thêm tham số Optional ByVal so = 1, trong:

Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant

Có tác dụng gì thế ạ?
If Not .exists(MyArray(i, so)) Then

OT thử thay thẳng số 1 vào:
If Not .exists(MyArray(i, 1)) Then
và sửa thành:

Function RemoveDupesDict(MyArray As Variant, Optional ByVal dk = 1) As Variant

Thì code không có lỗi gì.
Như vậy cái "Optional ByVal so=1" dùng để lựa chọn trong trường hợp đặc biệt nào vậy ạ?

tam888 · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào snow25,
Bạn có thể giải thích thêm tham số Optional ByVal so = 1, trong:

Có tác dụng gì thế ạ?
If Not .exists(MyArray(i, so)) Then

OT thử thay thẳng số 1 vào:
If Not .exists(MyArray(i, 1)) Then
và sửa thành:

Thì code không có lỗi gì.
Như vậy cái "Optional ByVal so=1" dùng để lựa chọn trong trường hợp đặc biệt nào vậy ạ?

Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các codes sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)
Nên có thể người ta thích cột xét trùng là cột khác
Lưu ý hàm tẩy (remove ...

) trùng RemoveDupesDict ở đây chỉ xét 1 cột trùng của bảng MyArray

Các câu hỏi về mảng trong VBA (Array) (1 người xem)

Người dùng đang xem chủ đề này

Thành viên gắn bó

Thành viên gắn bó

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

I don't program, I beat code into submission!!!

Đang đi tìm hòn đá

Thành viên gắn bó

|||||||||||||

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Đang đi tìm hòn đá

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

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

I don't program, I beat code into submission!!!

|||||||||||||

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

Thành viên tiêu biểu

|||||||||||||

Thành viên tiêu biểu

Thành viên gắn bó

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

Thành viên tiêu biểu

Thành viên gắn bó

Gội rồi mới Cạo

Đang đi tìm hòn đá

Thành viên gắn bó

Thành viên gắn bó

/(hông là gì!

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

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

/(hông là gì!

Thành viên gắn bó

Thành viên gắn bó

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

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

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

Thành viên gắn bó

Thành viên gắn bó

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

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

|||||||||||||

Đang đi tìm hòn đá

Thành viên mới

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

Đang đi tìm hòn đá

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

Thành viên thường trực

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

Chuyên gia GPE

Thành viên thường trực

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

Thành viên thường trực

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

File đính kèm

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ắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

File đính kèm