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

  • Thread starter Thread starter viehoai
  • Ngày gửi Ngày gửi
Liên hệ QC

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

  • viehoai

    Thành viên gắn bó
    Tham gia
    22/5/09
    Bài viết
    2,599
    Được thích
    2,908
    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ị
     
    Xin chào các bạn
    Oanh Thơ đang sử dụng code sau để copy dữ liệu từ vùng "B7:D99" 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 ạ.
     
    Upvote 0
    Xin chào các bạn
    Oanh Thơ đang sử dụng code sau để copy dữ liệu từ vùng "B7:D99" 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
     
    Upvote 0
    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
     
    Upvote 0
    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.
     
    Upvote 0
    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 ạ:
    Untitled.png
     
    Upvote 0
    Upvote 0
    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ả.
     
    Upvote 0
    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
     
    Upvote 0
    đâ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 ạ.
     
    Upvote 0
    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 ạ.
    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é
     
    Upvote 0
    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
     
    Upvote 0
    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:D sang cột K:L
    Cách chuyển cứ mỗi 1 dòng tại cột C:D 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 ạ
    Untitled1.png
     
    Upvote 0
    Upvote 0
    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 ạ.
     
    Upvote 0
    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
     
    Upvote 0
    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 :D:p
     
    Upvote 0
    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 :D:p
    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
     
    Upvote 0
    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
     
    Upvote 0
    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
     
    Upvote 0
    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
     
    Upvote 0
    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 ạ.

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

    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à.
     
    Upvote 0
    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
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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á ^^)
     
    Upvote 0
    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
     
    Upvote 0
    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 :D:p
    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ả.
     
    Upvote 0
    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á!
     
    Upvote 0
    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
     
    Upvote 0
    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!
     
    Upvote 0
    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 chỉ chấp nhận mảng 1 chiều. Trong code của bạn ở thời điểm ADD thì ary là mảng 2 chiều có 13 dòng và 1 cột.

    Sửa thà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 dòng
    Mã:
    ary = Sheets("Sheet1").Range("C1:O1").Value
    ary là mảng 2 chiều có 1 dòng và 13 cột.

    Sau dòng
    Mã:
    ary = Application.Transpose(ary)
    thứ nhất ary là mảng 2 chiều có 13 dòng và 1 cột

    Sau dòng
    Mã:
    ary = Application.Transpose(ary)
    thứ hai ary là mảng 1 chiều có 13 phần tử (không có khái niệm dòng hay cột). Lúc này ary mới được vinh dự hầu ông JOIN.

    Nói cho cùng tôi và nhiều người chỉ hơn bạn chủ yếu là chúng tôi đọc help còn bạn không đọc. Một kho kiến thức ngay bên cạnh mà cứ chạy đi hỏi đâu đâu.

    12345.JPG
     
    Upvote 0
    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 đoạn trên cũng biết "gần đúng" lỗi ở đâu. Khi chạy code thì dòng
    Mã:
    .Add Type:=xlValidateList, Formula1:=Join(ary, ",")
    bị đánh dấu - cứ cho là gần đú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 bị lỗi thì sẽ có cửa sổ nhẩy ra ghi rõ nội dung lỗi và cả mã lỗi. Chả cần làm gì cũng biết nội dung và mã lỗi. Muốn biết lỗi ở dòng nào (cứ cho là gần đúng đi) thì nhấn Debug ở cửa sổ báo lỗi.

    112233.JPG

    Cũng chả cần tới hàm Error
    Mã:
    MsgBox Err.Description, , Err.Number
    Khi cần thì Err.Clear, Err.Raise. Tất cả nằm trong đối tượng Err

    Tìm dòng lỗi chỉ là một chuyện nhỏ. Mà thường thì ta cũng được chỉ ra "khu vực" bị lỗi. Cái quan trọng là tìm ra nguyên nhân, thủ phạm. Để làm được điều đó thì phải chịu khó tư duy, phán đoán và nếu cần thì đọc trợ giúp. Đọc về cái gì thì tư duy và phán đoán sẽ chỉ đường.

    Vd. trong trường hợp ở trên thì giá trị xlValidateList là hợp lệ - ít ra là ta có 99% chắc chắn là thế. Còn lại Join(ary, ",") thì "nhìn" có vẻ "ổn", nhưng đây là hàm chứ không phải là hằng như xlValidateList. Vậy ta tìm đọc lại về JOIN xem có chỗ nào ta dùng sai dấu, sai ký tự hay sai gì đó không. Có rất nhiều khi ta có hàm xịn, dùng mấy năm rồi, nhưng hôm nay giở chứng. Nếu là hàm xịn, mà JOIN là hàm xịn, thì 99% lỗi là do truyền tham số không hợp lệ vào hàm.
     
    Upvote 0
    Tìm dòng lỗi chỉ là một chuyện nhỏ. Mà thường thì ta cũng được chỉ ra "khu vực" bị lỗi. Cái quan trọng là tìm ra nguyên nhân, thủ phạ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!
     
    Upvote 0
    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 ạ.
     
    Upvote 0
    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"

    Untitled.jpg
     
    Upvote 0
    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 :D
    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
     
    Upvote 0
    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!
    Bạn để ý thì thấy tôi không nói tới đoạ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
    Vì theo tôi đoạn đó có thể có ích cho người hỏi.

    Còn những đoạn trước và sau nó không cần vì khi chạy code bạn đã được cung cấp thông tin quá rõ ràng rồi.
     
    Upvote 0
    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 ạ.
    Thì dùng FOR *** thôi.

    Nhưng trước hết phải biết mảng có bao nhiêu dòng và cột để duyệt theo dòng hay cột hay theo cả dòng và cột.
    arr = vung.Value
    1. Nếu arr được khai báo là mảng (Dim arr()) thì khi vùng là 1 ô (cell) thì sẽ có lỗi. Khi Dim arr (arr là Variant) thì không có lỗi.

    2. Nếu vung là 1 ô thì arr (Dim arr) là 1 giá trị, không phải là mảng.

    3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
    LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

    Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
    Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dòng.

    Trong code tổng quát thì phải lường được dữ liệu để xem dữ liệu có có không, có thể chỉ là 1 giá trị hay luôn là mảng ... Vd. Muốn tuồn các giá trị từ B2 tới ô cuối cùng không trống trong cột B vào mảng. Có thể sẩy ra trường hợp không có dữ liệu (từ B2 trở đi đều trống), chỉ có 1 ô (B2<>"" và từ B3 là trống), và nhiều ô. Nhưng nếu muốn tuồn từ B2:C2 tới "cuối" thì chỉ sẩy ra 2 trường hợp: hoặc không có dữ liệu hoặc nhiều ô (ít nhất là 1 dòng tuồn vào mảng, mà dòng Bk:Ck luôn có 2 ô)
    ---------
    Theo bạn thì code tuồn cứng nhắc một vùng có nhiều ô vào mảng nên ta cũng không kiểm tra mà biết ngay ary là mảng 2 chiều có 1 dòng và nhiều cột. Vậy ta duyệt mảng theo dò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 phát âm là phò nhé. Lại nhớ hồi nhỏ ở phố có "chị" hay đi chơi với nhiều anh. Bọn trẻ chỉ trỏ và nói: phò phi dê. Các bạn trẻ có biết phi dê là gì không? :D
     
    Lần chỉnh sửa cuối:
    Upvote 0
    đây bạn xem nhé không biết có ổn không :D
    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 ạ.
     
    Upvote 0
    Thì dùng FOR *** thôi.

    Nhưng trước hết phải biết mảng có bao nhiêu dòng và cột để duyệt theo dòng hay cột hay theo cả dòng và cột.
    arr = vung.Value
    1. Nếu arr được khai báo là mảng (Dim arr()) thì khi vùng là 1 ô (cell) thì sẽ có lỗi. Khi Dim arr (arr là Variant) thì không có lỗi.

    2. Nếu vung là 1 ô thì arr (Dim arr) là 1 giá trị, không phải là mảng.

    3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
    LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

    Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
    Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dòng.

    Trong code tổng quát thì phải lường được dữ liệu để xem dữ liệu có có không, có thể chỉ là 1 giá trị hay luôn là mảng ... Vd. Muốn tuồn các giá trị từ B2 tới ô cuối cùng không trống trong cột B vào mảng. Có thể sẩy ra trường hợp không có dữ liệu (từ B2 trở đi đều trống), chỉ có 1 ô (B2<>"" và từ B3 là trống), và nhiều ô. Nhưng nếu muốn tuồn từ B2:C2 tới "cuối" thì chỉ sẩy ra 2 trường hợp: hoặc không có dữ liệu hoặc nhiều ô (ít nhất là 1 dòng tuồn vào mảng, mà dòng Bk:Ck luôn có 2 ô)
    ---------
    Theo bạn thì code tuồn cứng nhắc một vùng có nhiều ô vào mảng nên ta cũng không kiểm tra mà biết ngay ary là mảng 2 chiều có 1 dòng và nhiều cột. Vậy ta duyệt mảng theo dò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 phát âm là phò nhé. Lại nhớ hồi nhỏ ở phố có "chị" hay đi chơi với nhiều anh. Bọn trẻ chỉ trỏ và nói: phò phi dê. Các bạn trẻ có biết phi dê là gì không? :D

    Kính chào bác Siwtom,
    Cháu cảm ơn bác ạ, những chỉ dẫn:
    ....
    3. Nếu vùng có 2 ô trở lên thì arr luôn là mảng 2 chiều. Chỉ số dòng và cột luôn tính từ 1, tức LBound(arr) = 1, LBound(arr, 2) = 1. Chỉ số cuối của dòng và cột là Ubound(arr) và UBound(arr, 2). Do LBound(arr) = 1, LBound(arr, 2) = 1 nên đó cũng là số dòng và số cột trong mảng arr.
    LBound(arr) và Ubound(arr) là viết tắt của LBound(arr, 1) và Ubound(arr, 1).

    Nếu vung là một đoạn dòng thì arr là mảng 2 chiều có 1 dòng và nhiều cột.
    Nếu vùng là một đoạn cột thì arr là mảng 2 chiều có 1 cột và nhiều dò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 :D

    Cảm ơn bác Siwtom
     
    Upvote 0
    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ỉ :D:D:D
    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.
     
    Upvote 0
    Anh ơi cách này của em có gì sai mà mảng kết quả không đủ nhỉ :D:D:D
    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

    Từ B->F thì chỉ có 5 cột?
     
    Upvote 0
    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á.
     
    Upvote 0
    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:

    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
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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
     
    Upvote 0
    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
    :D Cảm ơn anh. Cách của anh linh hoạt hơn của em khi cơi nới mảng.
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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 !
     
    Upvote 0
    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.
     
    Upvote 0
    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
     
    Upvote 0
    Upvote 0
    Nhưng tạo 10 mảng làm gì khi ở mỗi thời điểm chỉ dùng 1 mảng?

    Ngoài ra code không xử lý trường hợp khi ô cuối cùng ở cột K nằm ở dòng < 5. Lúc đó cũng cho vd. K4 & "MAO" & L4 vào đít to?

    Tham khảo (tôi viết chay vì lười tạ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
     
    Upvote 0
    Nhưng tạo 10 mảng làm gì khi ở mỗi thời điểm chỉ dùng 1 mảng?

    Ngoài ra code không xử lý trường hợp khi ô cuối cùng ở cột K nằm ở dòng < 5. Lúc đó cũng cho vd. K4 & "MAO" & L4 vào đít to?

    Tham khảo (tôi viết chay vì lười tạ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
     
    Upvote 0
    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 đỡ ạ.
     
    Upvote 0
    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:p
     
    Upvote 0
    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
     
    Upvote 0
    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
     
    Upvote 0
    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 ạ.

    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 ạ.
     
    Upvote 0
    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
     
    Upvote 0
    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.
     
    Upvote 0
    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
     
    Upvote 0
    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" ạ :D
     
    Upvote 0
    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/
     
    Upvote 0
    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.
     

    File đính kèm

    Upvote 0
    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 đỏ).
     
    Upvote 0
    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.
     
    Upvote 0
    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 bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

    Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạ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 có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

    Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

    Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạ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 xét trường hợp:
    - sheet1: A1 = 5
    - sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

    Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

    Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

    Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.
     
    Upvote 0
    Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.
    Đúng là chưa thấu đáo anh ạ, bạn ấy đang học
     
    Upvote 0
    Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

    Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

    Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

    Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

    Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết


    Bây giờ ta xét trường hợp:
    - sheet1: A1 = 5
    - sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

    Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

    Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

    Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khá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 xét trường hợp:
    - sheet1: A1 = 5
    - sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2
    Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có 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/

    Có lẽ chính vì để phát hiện trường hợp này mà người ta dù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 ạ.
     
    Lần chỉnh sửa cuối:
    Upvote 0
    @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) :)

    Đú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 ạ?
     
    Upvote 0
    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.
     
    Upvote 0
    Độ 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ơ
     
    Lần chỉnh sửa cuối:
    Upvote 0
    Upvote 0
    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:

    1546320241021.png
     
    Upvote 0
    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ó.
     
    Upvote 0
    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
     
    Upvote 0
    Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

    Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

    Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

    Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

    Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết


    Bây giờ ta xét trường hợp:
    - sheet1: A1 = 5
    - sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

    Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

    Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

    Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khá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.
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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
     
    Upvote 0
    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
    Untitled.jpg
     

    File đính kèm

    Lần chỉnh sửa cuối:
    Upvote 0
    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
     
    Upvote 0
    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 ạ.
     
    Upvote 0
    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ứ
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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?
     
    Upvote 0
    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.
     
    Upvote 0
    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/

    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 ạ.
     
    Upvote 0
    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)
     
    Lần chỉnh sửa cuối:
    Upvote 0
    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)
     
    Upvote 0
    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
     
    Upvote 0
    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 ạ?
     
    Upvote 0
    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 ạ?
    Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
    Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

    So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các codes sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)
    Nên có thể người ta thích cột xét trùng là cột khác
    Lưu ý hàm tẩy (remove ...:D ) trùng RemoveDupesDict ở đây chỉ xét 1 cột trùng của bảng MyArray
     
    Lần chỉnh sửa cuối:
    Upvote 0

    Bài viết mới nhất

    Back
    Top Bottom