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

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ị

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.

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

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

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

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

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

Ăn cùng góc phố

Thành viên mới

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

Ăn cùng góc phố

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

Đếm ngược thời gian