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,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ị
 
Ví dụ chổ này:
Mã:
MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) = MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) + 1
Thử sửa thành vày xem:
Mã:
[COLOR=#ff0000][B]p1[/B][/COLOR] = .Item(sArray(i, 2)): [COLOR=#ff0000][B]p2[/B][/COLOR] = MyDict(sArray(i, 1))
MyArr([COLOR=#ff0000][B]p1[/B][/COLOR], [COLOR=#ff0000][B]p2[/B][/COLOR]) =MyArr([COLOR=#ff0000][B]p1[/B][/COLOR], [COLOR=#ff0000][B]p2[/B][/COLOR]) + 1
Với p1p2 là 2 biến Long
Thí nghiệm xem có nhanh hơn không?
Ẹc... Ẹc...

Đúng là nhanh hơn thật! Nhanh hơn cũ 0.1 giây! Lạ quá ta? Mình nghĩ như vậy là tăng một công đoạn vì từ biến gán vào sẽ chậm hơn, ai nhè nó lại nhanh hơn. Chẳng hiểu +-+-+-+ ẹc ẹc..

PHP:
Sub Array2Dicts()
    Dim iC As Long, iR As Long, jC As Long, jR As Long
    Dim i As Long, j As Long, sArray, MyArr, MyDict As Object
    Dim T As Double: T = Timer
    sArray = Sheet1.Range("A2:B65536").Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(sArray, 1)
            If Not .Exists(sArray(i, 1)) Then
                iC = iC + 1
                .Add sArray(i, 1), iC
            End If
        Next
        ReDim MyArr(1 To UBound(sArray, 1), 1 To iC + 1)
        iR = 1: j = 1
        For i = 1 To UBound(sArray, 1)
            If Not .Exists(sArray(i, 2)) Then
                iR = iR + 1
                MyArr(iR, 1) = sArray(i, 2)
                .Item(sArray(i, 2)) = iR
            End If
            If Not MyDict.Exists(sArray(i, 1)) Then
                j = j + 1
                MyDict(sArray(i, 1)) = j
                MyArr(1, j) = sArray(i, 1)
            End If
            jC = .Item(sArray(i, 2)): jR = MyDict(sArray(i, 1))
            MyArr(jC, jR) = MyArr(jC, jR) + 1
        Next
    End With
    With Sheet1.Range("F1").Resize(iR, iC)
        .ClearContents
        .Value = MyArr
    End With
    Set MyDict = Nothing
    Sheet1.Range("F1").Value = Timer - T
End Sub
 
Upvote 0
À, hiểu rồi, thay vì nó tính tới 4 lần, giờ nó giảm được 2 lần tính! }}}}}

Thanks Mr. Thầy!
 
Upvote 0
Đúng là nhanh hơn thật! Nhanh hơn cũ 0.1 giây! Lạ quá ta? Mình nghĩ như vậy là tăng một công đoạn vì từ biến gán vào sẽ chậm hơn, ai nhè nó lại nhanh hơn. Chẳng hiểu +-+-+-+ ẹc ẹc..

Đơn giản vì code cũ phải tính 2 lần: Lần 1 ở vế bên trái, lần 2 ở vế bên phải
Code cải tiến lại chỉ tính có 1 lần (tính xong, gán vào luôn)
Code viét dài thêm, ta có cảm giác là THÊM CÔNG ĐOẠN, thật ra Windows nó hổng phải tính như vậy ---> Thêm biến hay không thêm biến cũng không sao, vấn đề là phải hình dung xem máy nó tính thế nào
Lấy 1 ví dụ khác tham khảo:
- Để phòng dữ liệu rổng, ta thêm đoạn IF như sau:
Mã:
If tmp1 <> "" and tmp2 <> "" then
.....
End If
Nếu cả 2 cột A, B không có cell rổng thì chẳng nói làm gì. Đặt trường hợp có cell rổng nằm rải rác thì phải viết thế này mới nhanh:
Mã:
If tmp1 <> "" then
  If tmp2 <> "" then
  .....
  End IF
End If
- Trường hợp dùng 1 IF có AND: lần nào cũng phải xét 2 điều kiện (dù tmp1 có thế nào thì nó cũng xét tiếp tmp2)
- Trường hợp dùng 2 IF: sẽ theo phương pháp loại trù, nếu tmp = rổng thì... khỏi cần làm tiếp công đoạn xét tmp2 làm gì
 
Upvote 0
Tôi có 10 số tự nhiên 1,2,3,4,5,6,7,8,910 bây giờ tôi muốn đưa cả 10 số này vào một mảng dọc (mảng có tên là Arr) thì tôi phải viết như thế nào cho đúng?

Xin cảm ơn rất nhiều
 
Upvote 0
Bạn cứ làm 1 trong 2 cái này thử xem:

PHP:
Sub Test1()
    Dim MyArr
    MyArr = Application.WorksheetFunction.Transpose(Sheet1.Range("B1:K1").Value)
    Sheet1.Range("A2").Resize(UBound(MyArr, 1), 1).Value = MyArr
End Sub

PHP:
Sub Test2()
    Dim MyArr
    MyArr = Application.WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))
    Sheet1.Range("A2").Resize(UBound(MyArr, 1), 1).Value = MyArr
End Sub
 
Upvote 0
Tôi có 10 số tự nhiên 1,2,3,4,5,6,7,8,910 bây giờ tôi muốn đưa cả 10 số này vào một mảng dọc (mảng có tên là Arr) thì tôi phải viết như thế nào cho đúng?

Xin cảm ơn rất nhiều
Dùng thế này cho dễ hiểu về mảng ngang và dọc. Hy vọng bạn hiểu với trình độ mô phạm khiêm tốn.
PHP:
Sub TaoArr01()
 'Mang doc'
Dim i&
Dim Arr(1 To 10, 1 To 1)
For i = 1 To 10
  Arr(i, 1) = i
Next i
 MsgBox UBound(Arr) 'Can tren - Num of rows'
 MsgBox LBound(Arr) 'Can duoi - Num of columns'
Erase Arr ' Xoa Arr
End Sub
Sub TaoArr02()
 'Mang ngang'
Dim i&
 Dim Arr(1 To 10) 'khai bao chieu'
For i = 1 To 10
  Arr(i) = i
Next i
 MsgBox UBound(Arr) 'Can tren - Num of rows'
Erase Arr ' Xoa Arr
End Sub
Sub TaoArr03()
 'Mang ngang - giong nhu TaoArr02'
Dim i&
Dim Arr()
For i = 1 To 10
   ReDim Preserve Arr(1 To i) 'Khai bao lai'
  Arr(i) = i
Next i
 MsgBox UBound(Arr) 'Can tren - Num of rows'
Erase Arr ' Xoa Arr
End Sub
 
Upvote 0
Cảm ơn 2 bác ThuNghi và Minhthien, lỗi tại tôi không nói rõ mục đích bài toán của mình

Bài toán của tôi là
Trong cột A bao gồm rất nhiều mã số số 1,2,3,4,5,6,7,8,9,10,11,12..., tương ứng với cột B là giá trị của từng mã số đó.
Yêu cầu đặt ra là lọc ra những dòng mà mã số của cột A (1,2,3,4,5,6,7,8,9,11) thôi. Đem nó sang Sheet khác.

Ý định của tôi là muốn lập một mảng (Arr)bao gồm 10 phần tử đã được xác định (đã biết trước) cụ thể như sau là 1,2,3,4,5,6,7,8,9,11, không nhất thiết phải cho nó hiện ra màn hình (vì mục đích để đưa nó vào Dictionary).
Sau này tôi sẽ dùng Dic này đi kiểm tra trong toàn bộ cột A nếu gặp giá trị nào đã có trong Dic thì sẽ lọc dòng đó sang cột B

Xin kính mong hãy giúp tôi.
 

File đính kèm

  • Bai toan loc.xls
    27 KB · Đọc: 50
Upvote 0
Cảm ơn 2 bác ThuNghi và Minhthien, lỗi tại tôi không nói rõ mục đích bài toán của mình

Bài toán của tôi là
Trong cột A bao gồm rất nhiều mã số số 1,2,3,4,5,6,7,8,9,10,11,12..., tương ứng với cột B là giá trị của từng mã số đó.
Yêu cầu đặt ra là lọc ra những dòng mà mã số của cột A (1,2,3,4,5,6,7,8,9,11) thôi. Đem nó sang Sheet khác.

Ý định của tôi là muốn lập một mảng (Arr)bao gồm 10 phần tử đã được xác định (đã biết trước) cụ thể như sau là 1,2,3,4,5,6,7,8,9,11, không nhất thiết phải cho nó hiện ra màn hình (vì mục đích để đưa nó vào Dictionary).
Sau này tôi sẽ dùng Dic này đi kiểm tra trong toàn bộ cột A nếu gặp giá trị nào đã có trong Dic thì sẽ lọc dòng đó sang cột B

Xin kính mong hãy giúp tôi.
Bài này cũng giống dạng vlookup nhưng nó sẽ tìm nhiều mã số trùng.
Nếu 1,2,3...9... mà theo quy luật thì kg cần dùng Dic. Nhưng bạn muốn dùng Dic thì làm như sau
1/ Add cái Array(1, 2, 3, 4, 5, 6, 7, 8, 10, 11) vài Dic
2/ Dò tìm cột A nếu Dic.Exists thì lấy KQ.
PHP:
Dim Arr, ArrKQ, ArrSo
Dim Tmp
Dim Dic As Object
ArrSo = Array(1, 2, 3, 4, 5, 6, 7, 8, 10, 11)
T = Timer
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(ArrSo) 'Luu y so 0
  Dic.Add ArrSo(i), Nothing
Next i
With Sheets("sheet1")
  .AutoFilterMode = False
  endR = .Cells(65000, 1).End(3).Row
  Arr = .Range(.Cells(2, 1), .Cells(endR, 2)).Value
End With
iR = 0
ReDim ArrKQ(1 To UBound(Arr), 1 To 2)
For i = 1 To UBound(Arr)
  If Len(CStr(Arr(i, 1))) > 0 Then
    Tmp = Arr(i, 1)
    If Dic.Exists(Tmp) Then
      iR = iR + 1
      ArrKQ(iR, 1) = Tmp
      ArrKQ(iR, 2) = Arr(i, 2)
    End If
  End If
Next i
If iR Then
  With Sheets("sheet2").[A2]
    .Resize(1000, 2).ClearContents
    .Resize(iR, 2) = ArrKQ
  End With
End If
Erase Arr, ArrKQ, ArrSo
Set Dic = Nothing
MsgBox Timer - T
End Sub
 
Upvote 0
Bài này cũng giống dạng vlookup nhưng nó sẽ tìm nhiều mã số trùng.
Nếu 1,2,3...9... mà theo quy luật thì kg cần dùng Dic. Nhưng bạn muốn dùng Dic thì làm như sau
1/ Add cái Array(1, 2, 3, 4, 5, 6, 7, 8, 10, 11) vài Dic
2/ Dò tìm cột A nếu Dic.Exists thì lấy KQ.
PHP:
Dim Arr, ArrKQ, ArrSo
Dim Tmp
Dim Dic As Object
ArrSo = Array(1, 2, 3, 4, 5, 6, 7, 8, 10, 11)
T = Timer
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(ArrSo) 'Luu y so 0
  Dic.Add ArrSo(i), Nothing
Next i
With Sheets("sheet1")
  .AutoFilterMode = False
  endR = .Cells(65000, 1).End(3).Row
  Arr = .Range(.Cells(2, 1), .Cells(endR, 2)).Value
End With
iR = 0
ReDim ArrKQ(1 To UBound(Arr), 1 To 2)
For i = 1 To UBound(Arr)
  If Len(CStr(Arr(i, 1))) > 0 Then
    Tmp = Arr(i, 1)
    If Dic.Exists(Tmp) Then
      iR = iR + 1
      ArrKQ(iR, 1) = Tmp
      ArrKQ(iR, 2) = Arr(i, 2)
    End If
  End If
Next i
If iR Then
  With Sheets("sheet2").[A2]
    .Resize(1000, 2).ClearContents
    .Resize(iR, 2) = ArrKQ
  End With
End If
Erase Arr, ArrKQ, ArrSo
Set Dic = Nothing
MsgBox Timer - T
End Sub

Tức là ý anh theo quy luật từ 1 đến 9 chẳng hạn, thì mình đi dò cứ tên nào nằm trong khoảng này thì nhặt ra.
 
Upvote 0
Chưa hiểu lắm về mảng, nhờ giải thích

Tôi làm thử Code sau
PHP:
Sub Btoan()
Dim Arr()
Arr = Array(1, 2, 3, 4, 5, 6, 7)
i = UBound(Arr, 1)
MsgBox i
End Sub

Chạy ra hộp thoại sao i= 6 nhỉ? Rõ ràng là 7 phần tử mà.

Tôi các số trong ngoặc (1, 2, 3, 4, 5, 6, 7) chính là giá trị thật của các phần tử trong Arr thì phải diễn giải làm sao? Tức
Arr(1)=1
Arr(2)=2
Arr(3)=3
Arr(4)=4
Arr(5)=5
Arr(6)=6
Arr(7)=7
 
Upvote 0
Tôi làm thử Code sau
PHP:
Sub Btoan()
Dim Arr()
Arr = Array(1, 2, 3, 4, 5, 6, 7)
i = UBound(Arr, 1)
MsgBox i
End Sub

Chạy ra hộp thoại sao i= 6 nhỉ? Rõ ràng là 7 phần tử mà.

Tôi các số trong ngoặc (1, 2, 3, 4, 5, 6, 7) chính là giá trị thật của các phần tử trong Arr thì phải diễn giải làm sao? Tức
Arr(1)=1
Arr(2)=2
Arr(3)=3
Arr(4)=4
Arr(5)=5
Arr(6)=6
Arr(7)=7
Thêm chữ Option Base 1 vào đầu code sẽ thấy ngay, nghiên cứu thêm về option Base.
PHP:
Option Base 1
Sub Btoan()
Dim Arr()
Arr = Array(1, 2, 3, 4, 5, 6, 7)
i = UBound(Arr, 1)
MsgBox i
End Sub
 
Upvote 0
Tôi làm thử Code sau
PHP:
Sub Btoan()
Dim Arr()
Arr = Array(1, 2, 3, 4, 5, 6, 7)
i = UBound(Arr, 1)
MsgBox i
End Sub

Chạy ra hộp thoại sao i= 6 nhỉ? Rõ ràng là 7 phần tử mà.

Tôi các số trong ngoặc (1, 2, 3, 4, 5, 6, 7) chính là giá trị thật của các phần tử trong Arr thì phải diễn giải làm sao? Tức
Arr(1)=1
Arr(2)=2
Arr(3)=3
Arr(4)=4
Arr(5)=5
Arr(6)=6
Arr(7)=7
Số thứ tự bắt đầu của Arr là 0 chứ không phải 1 (cái này theo mặc định Base 0)
UBound(Arr, 1) = 6 vì tính từ 0 trở đi nên tổng số phần tử vẫn là 7
Arr(0) = 1
....
....
Arr(6) = 7
 
Upvote 0
Cám ơn bác Ndu, tôi chưa biết, thế thì Ubound hiểu là số thứ tự cuối cùng của mảng chứ không phải là tổng số phần tử, trước kia tôi hiểu là tổng số phần tử.
 
Upvote 0
Sau khi viết Code xong chạy thì phát hiện ra lỗi 9 kiểm tra mãi chẳng thấy chỗ sai, xin nhờ giúp đỡ

PHP:
Sub Loc()
Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:B" & Dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
Arr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then
     Tmp = Arr(i, 1)
        If Not Dic.Exists(Tmp) Then
          Dic.Add Tmp, ""
        End If
     End If
Next
For j = 1 To UBound(DL, 1)
    If Dic.Exists(DL(j, 1)) Then
      m = m + 1
      KQ(m, 1) = DL(j, 1)
      KQ(m, 2) = DL(j, 2)
    End If
Next
With Sheets("sheet2")
.Range("A:B").ClearContents
.[A2].Resize(m, 2).Value = KQ
End With
End Sub
 
Upvote 0
Sau khi viết Code xong chạy thì phát hiện ra lỗi 9 kiểm tra mãi chẳng thấy chỗ sai, xin nhờ giúp đỡ

Lỗi này chắc là lỗi tràn dòng, bạn thử cái này:
Thay vì:

If Arr(i, 1) <> "" Then
Tmp
= Arr(i, 1)



Bạn sửa thành:

If Arr(i) <> "" Then
Tmp = Arr(i)
 
Lần chỉnh sửa cuối:
Upvote 0
Vẫn chưa được anh Nghĩa ah. Tôi cứ tưởng 2 cái đó giống nhau chứ (m,Ubound(KQ)) nhỉ?
 
Upvote 0
Cám ơn bác Ndu, tôi chưa biết, thế thì Ubound hiểu là số thứ tự cuối cùng của mảng chứ không phải là tổng số phần tử, trước kia tôi hiểu là tổng số phần tử.
Chính xác là thế
Vì vậy, nếu phải tính số phần tử thì phải: UBound() - LBound() + 1 mới đúng
Nói thêm:
- Mảng được tạo ra bằng 2 cách: tự mình tạo ra (bằng vòng lập chẳng hạn) và mảng được gán từ 1 mảng (hoặc 1 Range) khác
- Với mảng do ta tự tạo ra, theo mặc định thì nó sẽ theo chuẩn Base 0 (tức STT phần tử đầu tiên luôn =0). Ta có thể chủ động thiết lập lại STT này bằng 2 cách:
a> Đặt câu lệnh Option Base n lên trên cùng, trên cả tên Sub (với n chỉ có thể = 0 hoặc 1) ---> STT phần tử đầu tiên của mảng sẽ theo số n này
b> Chủ động ngay tại công đoạn khai báo biến mảng, chẳng hạn Dim Arr(1 to 100) thì STT phần tử đầu tiên của Arr sẽ =1
- Với mảng được gán từ 1 mảng khác thì mảng kết quả sẽ có Base của mảng nguồn (ta không chỉnh được) ---> Ví dụ Arr = Dic.Keys (với Dic là Dictionary) thì cho dù có khai báo Option Base 1 trên đầu code, Arr vẫn cứ có STT phần tử đầu tiên luôn =0
----------------
Vài kiến thức mà tôi biết được!
Hy vọng "trợ lực" cho bạn đủ tự tin để vấn thân vào "con đường đau khổ" nhưng rất thú vị này
 
Upvote 0
Vẫn chưa được anh Nghĩa ah. Tôi cứ tưởng 2 cái đó giống nhau chứ (m,Ubound(KQ)) nhỉ?




Sửa lại bài dưới rồi đó: (tại nảy coi sơ, giờ nhìn kỹ lại)

Lỗi này chắc là lỗi tràn dòng, bạn thử cái này:
Thay vì:

If Arr(i, 1) <> "" Then
Tmp
= Arr(i, 1)



Bạn sửa thành:

If Arr(i) <> "" Then
Tmp = Arr(i)

Vã lại đã đặt mảng là Arr = Array() thì đâu cần thủ tục If Arr(i) <> "" Then làm chi cho phí sức!
 
Lần chỉnh sửa cuối:
Upvote 0
Sau khi viết Code xong chạy thì phát hiện ra lỗi 9 kiểm tra mãi chẳng thấy chỗ sai, xin nhờ giúp đỡ

PHP:
Sub Loc()
Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:B" & Dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
Arr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then
     Tmp = Arr(i, 1)
        If Not Dic.Exists(Tmp) Then
          Dic.Add Tmp, ""
        End If
     End If
Next
For j = 1 To UBound(DL, 1)
    If Dic.Exists(DL(j, 1)) Then
      m = m + 1
      KQ(m, 1) = DL(j, 1)
      KQ(m, 2) = DL(j, 2)
    End If
Next
With Sheets("sheet2")
.Range("A:B").ClearContents
.[A2].Resize(m, 2).Value = KQ
End With
End Sub
Mảng Arr là mảng 1 chiều mà bạn lại ghi là
Mã:
If Arr(i, 1) <> "" Then
Tmp = Arr(i, 1)
Tức xem nó là 2 chiều rồi, sao mà được chứ
Lý ra phải là
Mã:
If Arr(i) <> "" Then
 Tmp = Arr(i)
Mà thật ra cũng không cần công đoạn xet Arr(i) có rổng hay không... Vì cái thằng Arr này bạn tự mình thiết lập mà Arr = Array(1, 2, 3, 4, 5, 6, 7, 8) ---> Sao có vụ rổng được
Ngoài ra xin nói thêm: Nên khai báo đầy đủ tất cả các biến ---> Đó là thói quen tốt và nó cũng góp phần tăng tốc độ tính toán đây
 
Upvote 0
Rất ổn rồi thày ah, nếu không nhờ thày và anh minhthien giúp chắc bản thân tôi không tìm ra được (chưa phân biệt được mảng 2 chiều và 1 chiều, cứ nghĩ mảng 1 dọc là mảng 2 chiều đặc biệt chiều kia bằng số phần tử, chiều còn lại là 1 chứ... hichic)

PHP:
Sub Loc()
Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long, m As Long
With Sheets("sheet1")
On Error Resume Next
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:B" & Dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
Arr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr, 1)
     Tmp = Arr(i)
        If Not Dic.Exists(Tmp) Then
          Dic.Add Tmp, ""
        End If
Next
For j = 1 To UBound(DL, 1)
    If Dic.Exists(DL(j, 1)) Then
      m = m + 1
      KQ(m, 1) = DL(j, 1)
      KQ(m, 2) = DL(j, 2)
    End If
Next
End With
With Sheets("sheet2")
.Range("A:B").ClearContents
.[A2].Resize(m, 2).Value = KQ
End With
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom