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ị

ptm0412 · 18/5/11

Sao lại vầy:
ReDim arr(UBound(sarr, 1), LBound(sarr, 1))

Như vầy mới đúng chứ:
ReDim arr(UBound(sarr, 1), UBound(sarr, 2))
hoặc:
ReDim arr(UBound(sarr, 1), 1)

Em tìm trên mạng thì trang này nó nói rằng http://www.mrexcel.com/forum/showthread.php?t=550686

Mấy anh bên đó chưa học Array từ GPE nên xử lý 550.000 dòng nhanh nhất là 5 phút. Con nmhung49 xơi 800.000 dòng có 15 giây! (Máy cùn P4 của công ty đó nha, máy khác còn khủng thế nào nữa à.)

Nói tới dữ liệu lớn thì đừng nói gì công thức, AutoFilter cũng chết ngắc. Copy, Paste sau khi Filter cũng đi die, vì nó gồm quá nhiều mảnh nhỏ ghép lại, không phải 1 range liên tục.
Đã thí nghiệm:
Để nguyên không filter: copy, paste 800.000 cells vẫn được.
Sau khi filter: Copy bị báo lỗi như trên.
---------------------
Quên để ý vụ cells(li, 1).Value
Thay bằng sarr(li, 1)
Code chạy dưới 1 giây!

concogia · 18/5/11

Sub hocmang()
Dim arr(), sarr As Variant, li As Long, lj As Long
sarr = Range("a1:a808945").Value
ReDim arr(UBound(sarr, 1), LBound(sarr, 1))
Cái em này khai báo "trật lấc", sửa lại như Thầy ptm & ndu
Còn nếu biết chắc là 1 cột thì khai báo vầy cho gọn Redim arr(1 to UBound(sarr),1 to 1)
For li = 1 To UBound(arr, 1)
Nếu cho chạy theo dòng chỉ cần UBound(arr)
If Cells(li, 1).Value = "111250000125" Then
Cái em này cũng trật lấc, may mà dữ liệu của bạn ở cột A chứ ở cột khác là code này "tèo" chắc
lj = lj + 1
arr(lj, 1) = sarr(li, 1)
End If
Next li
[d1:d130000] = arr
Cái em này lý ra bạn viết
[d1].Resize(lj) = arr
End Sub
Nói chung, bài này viết đúng nó chạy cái.....roẹt là xong
Thân

nmhung49 · 18/5/11

ptm0412 đã viết:
Sao lại vầy:
ReDim arr(UBound(sarr, 1), LBound(sarr, 1))

Như vầy mới đúng chứ:
ReDim arr(UBound(sarr, 1), UBound(sarr, 2))
hoặc:
ReDim arr(UBound(sarr, 1), 1)

Mấy anh bên đó chưa học Array từ GPE nên xử lý 550.000 dòng nhanh nhất là 5 phút. Con nmhung49 xơi 800.000 dòng có 15 giây! (Máy cùn P4 của công ty đó nha, máy khác còn khủng thế nào nữa à.)

Nói tới dữ liệu lớn thì đừng nói gì công thức, AutoFilter cũng chết ngắc. Copy, Paste sau khi Filter cũng đi die, vì nó gồm quá nhiều mảnh nhỏ ghép lại, không phải 1 range liên tục.
Đã thí nghiệm:
Để nguyên không filter: copy, paste 800.000 cells vẫn được.
Sau khi filter: Copy bị báo lỗi như trên.
Code chạy dưới 1 giây!

Đọc xong mấy bài các anh và Thầy em thấy code mình củ chuối thiệt chứ, cố gắng cải thiện để mà hỏi tiếp ặc...ặc... --=0

mà sao em thấy diễn đàn mình không là thành viên của MVP của Microsoft hen thấy cũng lạ

Quên để ý vụ cells(li, 1).Value
Thay bằng sarr(li, 1)

Cho em hỏi sarr(li,1) nó hoạt động làm sao theo em nghĩ thì có phải nó duyệt qua từ giá trị trong mảng sarr = range("a1:a808945").value phải không ah!!

ptm0412 · 18/5/11

nmhung49 đã viết:
Cho em hỏi sarr(li,1) nó hoạt động làm sao theo em nghĩ thì có phải nó duyệt qua từ giá trị trong mảng sarr = range("a1:a808945").value phải không ah!!

Bạn đã gán giá trị của range A1:A808945 vào mảng sarr trong câu:
sarr = Range("a1:a808945").Value

Vậy thì dò tìm, cũng dò tìm trên sarr, xét điều kiện, cũng xét điều kiện trên sarr, và truy xuất cũng truy xuất trên sarr.
Chứ mà cứ ngó ngó xuống cell thì ... gán sarr làm gì?

em nghĩ thì có phải nó duyệt qua từ giá trị trong mảng

Đúng, duyệt từng giá trị trong mảng, nhưng là mảng sarr, không phải range dưới sheet nữa. Có thế mới nhanh được chứ!

nmhung49 · 25/5/11

Cho em hỏi có cách nào mình đổi tên sheet bằng cách dùng mảng không vậy các bạn. Thương ngày mình dùng code này để đổi tên mấy hôm nay tìm cách dùng mảng để đổi tên mà không tài nào biết được +-+-+-+

. Mong các bạn giúp đỡ. Thanks

PHP:

Sub doiten()
Dim li As Long
For li = 1 To Sheets.Count
Sheets(li).Name = Cells(li, 1)
Next li
End Sub

ndu96081631 · 25/5/11

nmhung49 đã viết:
Cho em hỏi có cách nào mình đổi tên sheet bằng cách dùng mảng không vậy các bạn. Thương ngày mình dùng code này để đổi tên mấy hôm nay tìm cách dùng mảng để đổi tên mà không tài nào biết được . Mong các bạn giúp đỡ. Thanks

PHP:

Sub doiten() Dim li As Long For li = 1 To Sheets.Count Sheets(li).Name = Cells(li, 1) Next li End Sub

Có chăng là đổi mấy thằng Cells(li, 1) thành những phần tử trong mảng, nhưng tôi nghĩ chẳng ăn thua gì
Thử nghĩ xem người ta dùng 1 file nhiều nhất cũng chừng độ vài chục sheet ---> Tương ứng vòng lập duyệt bao nhiêu đó lần ---> Chẳng đáng bao nhiêu mà phải mất thời gian nghiên cứu (mà dù cố thì chắc cũng hổng có cách nào khác)

nmhung49 · 25/5/11

ptm0412 đã viết:
Code Test1 trong bài #29 của ndu đọc Mảng ban đầu lấy số lẻ xong phân phối cho mảng kết quả theo thứ tự ưu tiên hàng ngang trước, dọc sau.

Xin giới thiệu code Test2, lấy số lẻ xong, của cột nào để nguyên cột đó:

PHP:

Sub Test2() Dim sArray, Arr(), i As Long, j As Long, iR1 As Long, iR2 sArray = Range("A2:B11").Value ReDim Arr(1 To UBound(sArray), 1 To UBound(sArray, 2)) For i = 1 To UBound(sArray, 1) For j = 1 To UBound(sArray, 2) If sArray(i, j) Mod 2 Then Arr(IIf(j = 1, iR1, iR2) + 1, j) = sArray(i, j) If j = 1 Then iR1 = iR1 + 1 Else iR2 = iR2 + 1 End If End If Next Next Range("E2:F11") = Arr End Sub

Với đoạn code trên của Thấy Mỹ vậy cho em hỏi nếu dữ liệu nhiều hơn Range("A2:B11") cỡ chừng A2:AA100 thì mình không thể dùng

PHP:

If sArray(i, j) Mod 2 Then
        Arr(IIf(j = 1, iR1, iR2) + 1, j) = sArray(i, j)
        If j = 1 Then
            iR1 = iR1 + 1
        Else
            iR2 = iR2 + 1
        End If
     End If

được phải không ah, vậy cho cách nào linh hoạt hơn không các bạn, anh chị em mới học mảng nhiều khi câu hỏi ngô ghê xin đừng cười ạ. Thanks

ndu96081631 · 25/5/11

nmhung49 đã viết:
Với đoạn code trên của Thấy Mỹ vậy cho em hỏi nếu dữ liệu nhiều hơn Range("A2:B11") cỡ chừng A2:AA100 thì mình không thể dùng

PHP:

If sArray(i, j) Mod 2 Then Arr(IIf(j = 1, iR1, iR2) + 1, j) = sArray(i, j) If j = 1 Then iR1 = iR1 + 1 Else iR2 = iR2 + 1 End If End If

được phải không ah, vậy cho cách nào linh hoạt hơn không các bạn, anh chị em mới học mảng nhiều khi câu hỏi ngô ghê xin đừng cười ạ. Thanks

Vầy đi:
- Bước đầu tiếp cận với mảng 2 chiều, bạn cứ hãy tưởng tượng nó là Range đi ---> Cách truy xuất tương tự.
- Ngoài ra, nghĩ được cái gì thì cứ thí nghiệm rồi rút ra kết luận

ptm0412 · 25/5/11

nmhung49 đã viết:
Với đoạn code trên của Thấy Mỹ vậy cho em hỏi nếu dữ liệu nhiều hơn Range("A2:B11") cỡ chừng A2:AA100 thì mình không thể dùng

PHP:

If sArray(i, j) Mod 2 Then Arr(IIf(j = 1, iR1, iR2) + 1, j) = sArray(i, j) If j = 1 Then iR1 = iR1 + 1 Else iR2 = iR2 + 1 End If End If

được phải không ah, vậy cho cách nào linh hoạt hơn không các bạn, anh chị em mới học mảng nhiều khi câu hỏi ngô ghê xin đừng cười ạ. Thanks

Gợi ý như sau:
Do biết trước chỉ có 2 cột, nên ta dùng 2 biến iR1 và iR2
Không biết bao nhiêu cột thì dùng biến mảng iR()
ReDim iR(1 To cái gì đó thích hợp, suy nghĩ nha)

Rồi sau đó, j bằng bi nhiu, tăng iR(j) lên 1
rồi ....

nmhung49 · 25/5/11

ptm0412 đã viết:
Gợi ý như sau:
Do biết trước chỉ có 2 cột, nên ta dùng 2 biến iR1 và iR2
Không biết bao nhiêu cột thì dùng biến mảng iR()
ReDim iR(1 To cái gì đó thích hợp, suy nghĩ nha)

Rồi sau đó, j bằng bi nhiu, tăng iR(j) lên 1
rồi ....

Dựa vào cách Thầy hướng dẫn em làm được file này lọc những ô có năm 2001, em nghĩ nó cũng giống cái lấy số lẻ. Mong Thầy và các bạn hướng dẫn giúp.Thanks

PHP:

Sub locdulieu1()
Dim mang, smang(), li As Long, lj As Long, lr As Long, rmang(), lm As Long
mang = [a1:d28]
ReDim smang(1 To UBound(mang, 1), 1 To UBound(mang, 2))
For li = 1 To UBound(mang, 2)
    For lj = 1 To UBound(mang, 1)
        If lj = 1 Then
        lr = lr + 1
        lm = 0
        End If
        ReDim rmang(1 To lr)
        If mang(lj, li) = "2001" Then
        smang(lm + 1, UBound(rmang, 1)) = mang(lj, li)
        lm = lm + 1
        End If
    Next
Next
[f1].Resize(UBound(mang, 1), UBound(mang, 2)) = smang
End Sub

ptm0412 · 25/5/11

Như vậy sẽ gọn hơn:

PHP:

Sub locdulieu2()
Dim mang, smang(), li As Long, lj As Long, rmang() As Long
mang = [a1:d28]
ReDim smang(1 To UBound(mang, 1), 1 To UBound(mang, 2))
        ReDim rmang(1 To UBound(mang, 2))
For li = 1 To UBound(mang, 2)
    For lj = 1 To UBound(mang, 1)
        If mang(lj, li) = "2001" Then
        smang(rmang(li) + 1, li) = mang(lj, li)
        rmang(li) = rmang(li) + 1
        End If
    Next
Next
[f1].Resize(UBound(mang, 1), UBound(mang, 2)) = smang
End Sub

Khỏi cần lờ mờ, lờ rờ gì sất.

nmhung49 · 26/5/11

ptm0412 đã viết:

Như vậy sẽ gọn hơn:

PHP:

Sub locdulieu2()
Dim mang, smang(), li As Long, lj As Long, rmang() As Long
mang = [a1:d28]
ReDim smang(1 To UBound(mang, 1), 1 To UBound(mang, 2))
        ReDim rmang(1 To UBound(mang, 2))
For li = 1 To UBound(mang, 2)
    For lj = 1 To UBound(mang, 1)
        If mang(lj, li) = "2001" Then
        smang(rmang(li) + 1, li) = mang(lj, li)
        rmang(li) = rmang(li) + 1
        End If
    Next
Next
[f1].Resize(UBound(mang, 1), UBound(mang, 2)) = smang
End Sub

Khỏi cần lờ mờ, lờ rờ gì sất.

ReDim rmang(1 To UBound(mang, 2)). Theo em hiểu cái này tương đương với Redim rmang(1 to 4) là 4 dòng 1 cột. Còn rmang(li) = rmang(li)+1 Nếu em xét theo từng cột đi hen ví dụ cột từ A1:A28 có xuất hiện 10 số 2001 đi thì rmang(li) nó nhảy từ 1 đến 10 mà trong khi Redim rmang có từ 1 đến 4 mà không bị lỗi ta. Em có lờ mờ lờ sờ lắm mong Thầy giải thích thêm. Thanks

ptm0412 · 26/5/11

Ẹc ẹc,
1.
ReDim rmang(1 To UBound(mang, 2))
tức là
ReDim rmang(1 To 4)
vậy
rmang là mảng 1 chiều
nên
là mảng ngang
4 phần tử
sử dụng
tương ứng
4
cột

2. rmang(li) là giá trị phần tử thứ li, có thể thay đổi giá trị các phần tử đến bao nhiêu chẳng được?

3. đâu phải rmang(li) = 8 là phần tử thứ 8? Nên nhớ li chỉ chạy từ 1 đến 4 trong vòng lặp for thứ nhất.

TB:
lờ mờ là biến lm, lờ rờ là biến lr, ý là không cần 2 biến này nữa í!

nmhung49 · 26/5/11

ptm0412 đã viết:
Ẹc ẹc,
1.
ReDim rmang(1 To UBound(mang, 2))
tức là
ReDim rmang(1 To 4)
vậy
rmang là mảng 1 chiều nên là mảng ngang 4 phần tử sử dụng tương ứng 4 cột
TB:
lờ mờ là biến lm, lờ rờ là biến lr, ý là không cần 2 biến này nữa í!

Ặc...ặc.... Khi mình khai báo ReDim rmang(1 To 4) thì nó làm mảng 1 chiều em mới biết em cứ tưởng nó giống mình khai bao này rmang(A1:A10) chứ

rmang(li) là giá trị phần tử thứ li, có thể thay đổi giá trị các phần tử đến bao nhiêu chẳng được?

Vậy cái này thay đổi bao nhiêu cũng được hả Thầy /-*+/

3. đâu phải rmang(li) = 8 là phần tử thứ 8? Nên nhớ li chỉ chạy từ 1 đến 4 trong vòng lặp for thứ nhất.

Cái này em biết tại em thắc mắc chạy không báo lỗi nên giờ mới hiểu ra mà cũng chưa hiều cho lắm ục...uc.. +-+-+-+

. Em nghĩ tới đây là đủ rồi để dành cho các bạn khác hỏi nữa, hỏi hoài Thầy cũng kỳ ặc...ặc....Thanks Thầy Mỹ nhiều ;;;;;;;;;;;

ptm0412 · 26/5/11

Có gì mà không hiểu lắm rồi là ục ục

Đã khai báo Rmang() As Long nên:
- giá trị của các phần tử có thể thay bằng giá trị số lên đến giới hạn của long (số lớn lắm à)
- Không cần gán giá trị ban đầu đã có thể lấy giá trị phần tử của nó cộng 1 (ban đầu = 0)

Đã Redim Rmang(1 To 4), nên khi Li chạy từ 1 đến 4, ta hiểu là đang ở cột Li của mảng ban đầu, và cả cột Li của mảng kết quả,
Thế là ta ăn gian lấy giá trị thứ Li cộng 1, làm số thứ tự dòng thêm vào của mảng kết quả. Cộng 1 là để khỏi đè lên dòng cũ của mảng kết quả. Sau đó phải cộng 1, để có số dòng hiện có của cột Li của mảng kết quả. Lát nữa, gặp nữa, cộng 1 nữa.
Vì Li chạy từ 1 đến 4, Li = bi nhiu ta lấy bấy nhiu, nên bảo đảm đúng thứ tự cột.

ndu96081631 · 26/5/11

Khi làm việc với mảng, ta nên làm theo hướng tổng quát, tức xem như không biết trước mảng thuộc Base 0 hay Base 1.
Với bài của nmhung49 do lấy mảng từ Range nên cứ ngầm hiểu mảng này thuộc Base 1 (tức phần tử đầu tiên bắt đầu = 1)
Giả định rằng mảng nguồn được lấy từ... đâu đó tùy ý thì... coi chừng. Ví dụ thế này sẽ biết:

PHP:

Sub locdulieu1()
  Dim mang, smang(), li As Long, lj As Long, lr As Long, rmang(), lm As Long
  Sheet1.ListBox1.List() = Sheet1.Range("A1:D28").Value
  mang = Sheet1.ListBox1.List
  '...........................
  '............................
  [f1].Resize(UBound(mang, 1), UBound(mang, 2)) = smang
End Sub

Thử xem

nmhung49 · 6/6/11

Em có 1 thắc mắc không biết có cách nào mình lấy giá duy nhất của 1 vùng gán vào mảng không với điều kiện không dùng Scipting.dictionary. Em nghĩ tới dùng advance filter như phải dùng cột phụ không hay lắm

PHP:

Sub Loc()
Dim Rng As Range, arr
Sheet1.Range("b1").CurrentRegion.AdvancedFilter xlFilterCopy, , [d1], True
arr = Range("d1").CurrentRegion
End Sub

Vậy bác có cách nào lọc 1 mảng ảo không. Ví dụ mảng arr() có các giá trị như (1,2,3,2,3,4,7,8,1)
Và kết quả cho ra mng() có giá trị là (1,2,3,4,7,8).
Em đang cần.

Em thấy bài của anh Mr Okebab dùng công thức mà khó. Không biết mình có cách nào ngắn ngắn dễ hiểu không. Thanks
http://www.giaiphapexcel.com/forum/showthread.php?15834-%C4%90%E1%BA%BFm-s%E1%BB%91-ph%E1%BA%A7n-t%E1%BB%AD-%28duy-nh%E1%BA%A5t%29-c%C3%B3-trong-Dropdown-list-khi-AutoFilter/page3
http://www.giaiphapexcel.com/forum/showthread.php?37895-L%E1%BA%A5y-DM-duy-nh%E1%BA%A5t-theo-2-c%E1%BB%99t-Scripting.Dictionary%21

ndu96081631 · 7/6/11

nmhung49 đã viết:
Em có 1 thắc mắc không biết có cách nào mình lấy giá duy nhất của 1 vùng gán vào mảng không với điều kiện không dùng Scipting.dictionary. Em nghĩ tới dùng advance filter như phải dùng cột phụ không hay lắm

PHP:

Sub Loc() Dim Rng As Range, arr Sheet1.Range("b1").CurrentRegion.AdvancedFilter xlFilterCopy, , [d1], True arr = Range("d1").CurrentRegion End Sub

Em thấy bài của anh Mr Okebab dùng công thức mà khó. Không biết mình có cách nào ngắn ngắn dễ hiểu không. Thanks
http://www.giaiphapexcel.com/forum/showthread.php?15834-%C4%90%E1%BA%BFm-s%E1%BB%91-ph%E1%BA%A7n-t%E1%BB%AD-%28duy-nh%E1%BA%A5t%29-c%C3%B3-trong-Dropdown-list-khi-AutoFilter/page3
http://www.giaiphapexcel.com/forum/...-DM-duy-nhất-theo-2-cột-Scripting.Dictionary!

Không dùng Dictionary thì dùng Collection ---> Thuật toán tương tự và cách dùng cũng tương tự
Với giải pháp lọc duy nhất mà dùng code thì Dictionary mới chính là sở trường. Nó cũng đâu có khó hiểu lắm đâu ---> Bạn đang nghiên cứu về Array, thiết nghĩ cũng nên xem qua về Dictionary
Tôi cho bạn 1 ví dụ nhỏ
- Gõ vào vùng A1:A10 các số tùy ý (có thể trùng)
- Dùng code này thử kết quả

PHP:

Sub Test()
  Dim Clls As Range, Dic As Object
  Set Dic = CreateObject("Scripting.Dictionary")
  For Each Clls In Range("A1:A10")
    If Not Dic.Exists(Clls.Value) Then  '<--- Xét xem Clls.Value đã có trong Dic hay chưa, nếu chưa có thì thực hiện tiếp đoạn dưới
      Dic.Add Clls.Value, ""
      MsgBox Clls.Value
    End If
  Next
End Sub

ThuNghi · 7/6/11

ndu96081631 đã viết:
Tôi cho bạn 1 ví dụ nhỏ
- Gõ vào vùng A1:A10 các số tùy ý (có thể trùng)
- Dùng code này thử kết quả

PHP:

Sub Test() Dim Clls As Range, Dic As Object Set Dic = CreateObject("Scripting.Dictionary") For Each Clls In Range("A1:A10") If Not Dic.Exists(Clls.Value) Then '<--- Xét xem Clls.Value đã có trong Dic hay chưa, nếu chưa có thì thực hiện tiếp đoạn dưới Dic.Add Clls.Value, "" MsgBox Clls.Value End If Next End Sub

Theo code của NDU mày mò dùng tạm hàm Instr xem thế nào. Chắc là không thể nào nhanh bằng Dic.

PHP:

Sub TestInstr()
  Dim sTxt$
  Dim Clls As Range
  For Each Clls In Range("A1:A10")
    If Len(Clls.Value) > 0 Then
      If InStr(sTxt, vbBack & Clls.Value & vbBack) = 0 Then
        sTxt = sTxt & vbBack & Clls.Value & vbBack
      End If
    End If
  Next
  MsgBox Replace(sTxt, vbBack, "")
End Sub

ndu96081631 · 7/6/11

ThuNghi đã viết:
Theo code của NDU mày mò dùng tạm hàm Instr xem thế nào. Chắc là không thể nào nhanh bằng Dic.

PHP:

Sub TestInstr() Dim sTxt$ Dim Clls As Range For Each Clls In Range("A1:A10") If Len(Clls.Value) > 0 Then If InStr(sTxt, vbBack & Clls.Value & vbBack) = 0 Then sTxt = sTxt & vbBack & Clls.Value & vbBack End If End If Next MsgBox Replace(sTxt, vbBack, "") End Sub

Thứ nhất: Dùng phép xử lý chuổi thì chắc ăn không thể nào nhanh được ---> Dữ liệu nhiều chắc thè lưởi luôn
Thứ hai: Thuật toán cũng chắc gì đã dễ hiểu hơn Dictionary
Ẹc... Ẹc...

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

Thành viên gắn bó

Bad Excel Member

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

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

Bad Excel Member

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

Huyền thoại GPE

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

Huyền thoại GPE

Bad Excel Member

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

Bad Excel Member

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

Bad Excel Member

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

Bad Excel Member

Huyền thoại GPE

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

Huyền thoại GPE

Hãy cho rồi sẽ nhận!

Huyền thoại GPE