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

Liên hệ QC

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,600
Được thích
2,907
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ị
 
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
Web KT
Back
Top Bottom