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

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ị

khuongvietphong · 20/4/16

Nhờ mọi người xem giúp em File này. Mục đích của em là loại bỏ các giá trị trùng nhau đồng thời sắp xếp lại các phần tử của cột theo thứ tự tăng dần. Em không hiểu sao lại bị báo lỗi ở câu lệnh Redim Preserve ...

Cảm ơn mọi người !

dhn46 · 20/4/16

khuongvietphong đã viết:
Nhờ mọi người xem giúp em File này. Mục đích của em là loại bỏ các giá trị trùng nhau đồng thời sắp xếp lại các phần tử của cột theo thứ tự tăng dần. Em không hiểu sao lại bị báo lỗi ở câu lệnh Redim Preserve ...

Cảm ơn mọi người !

Hiểu nôm na là thế này bạn:

Code của bạn

Mã:

ReDim Preserve mang(1 To k, 1 To 1)

Tức là tăng số "Hàng"

Nhưng

Redim Preserve chỉ cho phép tăng số "Cột"

Gpe nói nhiều về cái này, bạn tìm hiểu thêm nhé

khuongvietphong · 20/4/16

hpkhuong đã viết:
Nghe đồn là muốn Redim Preserve thì lúc khai báo phải là
Dim mang
Redim mang(.....)

Rồi mới Redim Preserve được...

Em sửa như anh nói mà nó lại báo lỗi: Subscript out of range $:=\+$ $:=\+$

khuongvietphong · 20/4/16

dhn46 đã viết:
Hiểu nôm na là thế này bạn:

Code của bạn

Mã:

ReDim Preserve mang(1 To k, 1 To 1)

Tức là tăng số "Hàng"

Nhưng

Redim Preserve chỉ cho phép tăng số "Cột"

Gpe nói nhiều về cái này, bạn tìm hiểu thêm nhé

Em đã đổi lại thành Redim theo chiều cột rồi mà vẫn báo lỗi vậy ah

khuongvietphong · 20/4/16

hpkhuong đã viết:
Nhưng với bài toán của chàng thì làm gì mà phức tạp vậy

1. Viết 1 Dic lọc duy nhất bình thường, dán kết quả xuống sheet
2. Sau đó dùng excel mà Sort từ bé tới lớn là được kết quả như ý...

Đừng si nghĩ chi cho mệt óc nha em!

Vâng anh, tại em đang thử cách này để làm 1 bài toán khác í mà ...

Minh15.01.1991 · 20/4/16

khuongvietphong đã viết:
Vâng anh, tại em đang thử cách này để làm 1 bài toán khác í mà ...

Redim preserve chỉ cho phép thay đổi size của chìu cuối cùng thôi. Ví dụ mảng 2 chìu thì thay đổi được chiều thứ 2, mảng ba chiều thì thay đổi được chìu thứ 3.

Ba Tê · 20/4/16

khuongvietphong đã viết:
Vâng anh, tại em đang thử cách này để làm 1 bài toán khác í mà ...

Thử không xài "muối" mà xài "mắm" xem sao.

PHP:

Public Sub GPE()
Dim Arr, Tmp, dArr(), I As Long, Rws As Long, K As Long
Arr = Range("A1", Range("A1").End(xlDown)).Value
Rws = UBound(Arr)
ReDim Tmp(Rws)
For I = 1 To UBound(Arr)
    If Arr(I, 1) > Rws Then
        Rws = Arr(I, 1)
        ReDim Preserve Tmp(Rws)
    End If
        Tmp(Arr(I, 1)) = Arr(I, 1)
Next I
ReDim dArr(1 To Rws + 1, 1 To 1)
For I = 0 To Rws
    If Tmp(I) <> "" Then
        K = K + 1
        dArr(K, 1) = Tmp(I)
    End If
Next I
[R2].Resize(K) = dArr
End Sub

khuongvietphong · 20/4/16

Cảm ơn mọi người đã hỗ trợ. Em kết hợp cả 2 cách của anh hpkhuong với anh dhn46 lại thì ra được kết quả rồi

Cảm ơn thầy BaTe đã khuyến mãi thêm 1 cách làm nữa.

phihndhsp · 9/5/16

Gởi các bạn bài tập sử dụng mảng để tính subtotal cho các đối tượng, bài này tôi chỉ đưa ra ý tưởng là chèn thêm dòng total dưới các vị trí trùng nhau, các bạn có thể phát triển nó để có thể tính tổng con, đếm, hay tính trung bình của những nhóm, cái này tôi sử dụng mảng để chèn, và có sử dụng kỹ thuật chương trình con để làm
(code của tôi không có bẫy bất cứ lỗi gì? đây chỉ là ý tưởng nếu ai quan tâm thì có thể phát triển nhiều hướng cho mình, vì sử dụng chèn dòng trong excel với số lượng nhiều thì rất chậm)

Mã:

' Sub chen tung dong
Sub CHENDONG(VT_Chen As Long, Arr_D(), Sodong As Long)
Dim I As Long
   For I = Sodong To VT_Chen Step -1
     Arr_D(I, 1) = Arr_D(I - 1, 1)
   Next
   Arr_D(VT_Chen, 1) = "Total"
End Sub

Mã:

Sub Main()
Dim Arr_D(1 To 10000, 1 To 2)
Dim Arr_N()
Dim I As Long
Dim dongcuoi As Long
Dim VT_Chen As Long
Dim Sodong As Long


dongcuoi = Sheet1.Range("A10000").End(xlUp).Row
Arr_N = Sheet1.Range("A1:A" & dongcuoi + 1)
Sodong = UBound(Arr_N, 1)
'duyet tu dau den cuoi mang nguon gan vao mang dich
For I = 1 To UBound(Arr_N, 1)
  Arr_D(I, 1) = Arr_N(I, 1)
Next


' Kiem tra dieu kien tung phan tu neu Dung dieu kien thi goi sub chen dong
For I = UBound(Arr_N, 1) To 2 Step -1
  If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then
     VT_Chen = I
     Sodong = Sodong + 1
     Call CHENDONG(VT_Chen, Arr_D, Sodong)
  End If
 Next


Sheet1.Range("B1:B10000").Clear
Sheet1.Range("B1").Resize(Sodong, 1) = Arr_D
End Sub

doveandrose · 9/5/16

phihndhsp đã viết:
Gởi các bạn bài tập sử dụng mảng để tính subtotal cho các đối tượng, bài này tôi chỉ đưa ra ý tưởng là chèn thêm dòng total dưới các vị trí trùng nhau, các bạn có thể phát triển nó để có thể tính tổng con, đếm, hay tính trung bình của những nhóm, cái này tôi sử dụng mảng để chèn, và có sử dụng kỹ thuật chương trình con để làm
(code của tôi không có bẫy bất cứ lỗi gì? đây chỉ là ý tưởng nếu ai quan tâm thì có thể phát triển nhiều hướng cho mình, vì sử dụng chèn dòng trong excel với số lượng nhiều thì rất chậm)

Mã:

' Sub chen tung dong Sub CHENDONG(VT_Chen As Long, Arr_D(), Sodong As Long) Dim I As Long For I = Sodong To VT_Chen Step -1 Arr_D(I, 1) = Arr_D(I - 1, 1) Next Arr_D(VT_Chen, 1) = "Total" End Sub

Mã:

Sub Main() Dim Arr_D(1 To 10000, 1 To 2) Dim Arr_N() Dim I As Long Dim dongcuoi As Long Dim VT_Chen As Long Dim Sodong As Long dongcuoi = Sheet1.Range("A10000").End(xlUp).Row Arr_N = Sheet1.Range("A1:A" & dongcuoi + 1) Sodong = UBound(Arr_N, 1) 'duyet tu dau den cuoi mang nguon gan vao mang dich For I = 1 To UBound(Arr_N, 1) Arr_D(I, 1) = Arr_N(I, 1) Next ' Kiem tra dieu kien tung phan tu neu Dung dieu kien thi goi sub chen dong For I = UBound(Arr_N, 1) To 2 Step -1 If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then VT_Chen = I Sodong = Sodong + 1 Call CHENDONG(VT_Chen, Arr_D, Sodong) End If Next Sheet1.Range("B1:B10000").Clear Sheet1.Range("B1").Resize(Sodong, 1) = Arr_D End Sub

người viết ở trên quan tâm tới trường hợp số lượng lớn dòng dữ liệu trong excel , nhưng lại chọn cách viết code rất "hao xăng" để giải bài toán này ?
Tôi sẽ đi phân tích ý nghĩa đoạn ở trên . Giải thuật
Cứ gặp hiện tượng giá trị mảng của dòng hiện tại khác với dòng ngay trước nó

Mã:

If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then

thì số dòng tổng cộng trong mảng kết quả phải điều chỉnh tăng 1 ( vì chèn thêm dòng "total")
và tiến hành duyệt mảng kết quả , sửa lại ghi đè tất cả các giá trị đã gán trước đó .
Vậy với mỗi lần xảy ra

Mã:

If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then

lại tiến hành ghi đè tất cả các giá trị đã gán trước đó ?

Mã:

For I = Sodong To VT_Chen Step -1
     Arr_D(I, 1) = Arr_D(I - 1, 1)
   Next

như thế càng tiến gần về đích 2

Mã:

For I = UBound(Arr_N, 1) To 2 Step -1

thì số giá trị phải ghi đè càng lớn , điều này là đáng kể đối với excel dữ liệu lớn .
Nhưng tùy mỗi người nhận thức , có người cho rằng với bài này phải dùng kỹ thuật chia sub con mới là đỉnh cao của lập trình thì cũng được , tự do mà .
Với tôi thì theo đúng đề bài này tôi chỉ sử dụng 1 sub theo tinh thần duyệt mảng

Mã:

Public Sub hello()
Dim arr, dArr(1 To 100000, 1 To 1), r As Long, k As Long, ub As Long
arr = Sheet1.Range("A1:A" & Sheet1.[A10000].End(xlUp).Row).Value
ub = UBound(arr)
For r = 1 To ub Step 1
    k = k + 1
    dArr(k, 1) = arr(r, 1)
    If arr(r, 1) <> arr(WorksheetFunction.Min(r + 1, ub), 1) Or r = ub Then
        k = k + 1
        dArr(k, 1) = "total"
    End If
Next
Sheet1.Range("B1:B10000").Clear
Sheet1.Range("B1").Resize(k, 1) = dArr
End Sub

phihndhsp · 9/5/16

doveandrose đã viết:
người viết ở trên quan tâm tới trường hợp số lượng lớn dòng dữ liệu trong excel , nhưng lại chọn cách viết code rất "hao xăng" để giải bài toán này ?
Tôi sẽ đi phân tích ý nghĩa đoạn ở trên . Giải thuật
Cứ gặp hiện tượng giá trị mảng của dòng hiện tại khác với dòng ngay trước nó

Mã:

If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then

thì số dòng tổng cộng trong mảng kết quả phải điều chỉnh tăng 1 ( vì chèn thêm dòng "total")
và tiến hành duyệt mảng kết quả , sửa lại ghi đè tất cả các giá trị đã gán trước đó .
Vậy với mỗi lần xảy ra

Mã:

If (Arr_N(I, 1) <> Arr_N(I - 1, 1)) Then

lại tiến hành ghi đè tất cả các giá trị đã gán trước đó ?

Mã:

For I = Sodong To VT_Chen Step -1 Arr_D(I, 1) = Arr_D(I - 1, 1) Next

như thế càng tiến gần về đích 2

Mã:

For I = UBound(Arr_N, 1) To 2 Step -1

thì số giá trị phải ghi đè càng lớn , điều này là đáng kể đối với excel dữ liệu lớn .
Nhưng tùy mỗi người nhận thức , có người cho rằng với bài này phải dùng kỹ thuật chia sub con mới là đỉnh cao của lập trình thì cũng được , tự do mà .
Với tôi thì theo đúng đề bài này tôi chỉ sử dụng 1 sub theo tinh thần duyệt mảng

Mã:

Public Sub hello() Dim arr, dArr(1 To 100000, 1 To 1), r As Long, k As Long, ub As Long arr = Sheet1.Range("A1:A" & Sheet1.[A10000].End(xlUp).Row).Value ub = UBound(arr) For r = 1 To ub Step 1 k = k + 1 dArr(k, 1) = arr(r, 1) If arr(r, 1) <> arr(WorksheetFunction.Min(r + 1, ub), 1) Or r = ub Then k = k + 1 dArr(k, 1) = "total" End If Next Sheet1.Range("B1:B10000").Clear Sheet1.Range("B1").Resize(k, 1) = dArr End Sub

nếu không lại tiến hành ghi đè tất cả các giá trị đã gán trước đó ? Thì bạn cứ cho 1 giải thuật chèn dòng đi, theo sách vở thì tôi chỉ biết chèn dòng thì như vậy thôi, chả biết hơn nữa đâu(trong code của bạn thì bạn có lợi dụng hàm MIN trong excel, mà cái hàm đó suy cho cùng thì cũng dùng vòng lặp duyệt từ bên trong mà thôi). Ý thức tôi kém nên tôi mới biết tới là chia nhỏ chương trình con là đỉnh cao trong lặp trình thôi, còn những ý thức cao siêu thì tôi không biết
tôi chỉ biết là chương trình chính chỉ nên gọi các thủ tục và hàm, để người ta dễ hình dung chương trình làm gì và dễ kiểm soát lỗi thôi bạn

manggpe · 6/8/16

Xin chào đại gia đình GPE, trước tiên cho em cảm ơn đến tất cả các thành viên về các bài viết của anh chị đã giúp ích được rất nhiều người kể cả em.
em có 1 vấn đề này thắc mắc mà không biết giải quyết như thế nào? em có đọc bài anh lê văn duyệt về mảng nhưng chưa thực hành được
vấn đề 1:
em có đoạn code

Mã:

Dim Arr()
Arr = Array(Array(1, 2, 3))

dĩ nhiên Arr là mảng một chiều

nhưng lời của anh Lê văn duyệt
[FONT=&amp]Nếu dùng từ khóa Array, chỉ trả về mảng chỉ có một chiều nếu muốn trả về một mảng hai chiều chúng ta phải dùng [/FONT]Array(Array(…))

em muốn gán mảng 2 chiều theo yêu cầu này mà không được?

Mã:

Dim Arr()
Dim AB As Long
Arr = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12))
MsgBox Arr(1)(1)

em chỉ làm được như vậy thôi, mà như vậy thì nó là mảng một chiều trong mảng một chiều?
có cách nào gán mảng 2 chiều trực tiếp bằng array?
cũng là vấn đề này em muốn khai báo mảng tường minh được không
ví dụ
Arr(1 to 10) đây là mảng một chiều
còn mảng 1 chiều trong mảng 1 chiều khai báo sao?

Vấn đề 2:
khai báo mảng trong mảng, thao tác mảng trong mảng...
xin chân thành cảm ơn

Hoàng Trọng Nghĩa · 6/8/16

manggpe đã viết:
Xin chào đại gia đình GPE, trước tiên cho em cảm ơn đến tất cả các thành viên về các bài viết của anh chị đã giúp ích được rất nhiều người kể cả em.
em có 1 vấn đề này thắc mắc mà không biết giải quyết như thế nào? em có đọc bài anh lê văn duyệt về mảng nhưng chưa thực hành được
vấn đề 1:
em có đoạn code

Mã:

Dim Arr() Arr = Array(Array(1, 2, 3))

dĩ nhiên Arr là mảng một chiều

nhưng lời của anh Lê văn duyệt
[FONT=&amp]Nếu dùng từ khóa Array, chỉ trả về mảng chỉ có một chiều nếu muốn trả về một mảng hai chiều chúng ta phải dùng [/FONT]Array(Array(…))

em muốn gán mảng 2 chiều theo yêu cầu này mà không được?

Mã:

Dim Arr() Dim AB As Long Arr = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12)) MsgBox Arr(1)(1)

em chỉ làm được như vậy thôi, mà như vậy thì nó là mảng một chiều trong mảng một chiều?
có cách nào gán mảng 2 chiều trực tiếp bằng array?
cũng là vấn đề này em muốn khai báo mảng tường minh được không
ví dụ
Arr(1 to 10) đây là mảng một chiều
còn mảng 1 chiều trong mảng 1 chiều khai báo sao?

Vấn đề 2:
khai báo mảng trong mảng, thao tác mảng trong mảng...
xin chân thành cảm ơn

Vấn đề 1:

Đầu tiên, ta phải hiểu rằng Array là một hàm mảng một chiều.

[TABLE="width: 100%"]
[TR]
[TD="align: left"]Array Function[/TD]
[/TR]
[/TABLE]

Returns a Variant containing an array.

Thứ 2, với kiểu triển khai như thế này:

Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12))

được gọi là "mảng trong mảng", với mảng một chiều "mẹ" chứa các phần tử là các mảng một chiều "con" (có thể chứa thêm cháu chắt gì nữa cũng được).

Thứ 3, đã là hàm mảng 1 chiều thì không thể chuyển hàm Array thành mảng 2 chiều được. Vậy nên muốn có mảng 2 chiều, hoặc nhiều hơn thì ta phải khai báo.

Ví dụ:

Mã:

Dim Arr2D(1 To 5, 1 To 2)

Ta thấy rằng chiều "hàng" nó có 5 hàng, và chiều "cột" nó có 2 cột. Với mỗi hàng nó sẽ chứa 2 phần tử của cột, từ đó bạn sẽ hiểu tính chất của nó mà làm việc với mảng 2 chiều.

Khai báo mảng trong mảng 1 chiều ta chỉ khai báo 2 mảng, một mảng "mẹ" và một mảng "con" (nếu mảng con có số phần tử là bằng nhau).

Mã:

Dim Arr1D_Mother(1 To 10)
Dim Arr1D_Daugter(1 To 5)

Khi triển khai bạn cứ tạo mảng con trước sau đó "gán" nó thành một phần tử của mảng "mẹ" và cứ thế cho đến hết 10 phần tử.

Vấn đề 2:

Như đã nói ở phần màu xanh, dưới đây là code để chứng minh điều đó:

Mã:

Sub Test()
    Dim Arr1D_Mother(1 To 10)
    Dim Arr1D_Daugter(1 To 5)
    Dim c As Long, r As Long
    For r = 1 To 10
        For c = 1 To 5
            Arr1D_Daugter(c) = r & c
        Next
        Arr1D_Mother(r) = Arr1D_Daugter
    Next
    MsgBox Arr1D_Mother(3)(4)
End Sub

Như vậy, MsgBox sẽ cho ra kết quả là 34 (3 và 4) vì đó là số ghép giữa phần tử thứ 3 của mảng mẹ với phần tử thứ 4 của mảng con.

Với những gì tôi nêu trên, hy vọng bạn hiểu thêm về chúng.

manggpe · 6/8/16

Cảm ơn anh nghĩa nhiều, vấn đề này em đã tham khảo trong topic này trang 17 rồi. Em cũng hiểu và vận dụng được

Sub Test()
Dim Arr1D_Mother(1 To 10)
Dim Arr1D_Daugter(1 To 5)
Dim c As Long, r As Long
For r = 1 To 10
For c = 1 To 5
Arr1D_Daugter(c) = r & c
Next
Arr1D_Mother(r) = Arr1D_Daugter
Next
MsgBox Arr1D_Mother(3)(4)
End Sub
ý em muốn biết là mình có khai báo tường minh mảng con trong mảng mẹ hay không thôi? và cách truy xuất và gán giá trị ?
và vấn đề thứ nhất của em Array đúng là mảng một chiều, nhưng em có đọc bài anh Lê Văn Duyệt có nói là làm được nên em muốn tò mò xem sao thôi.
Nguyên văn bài của anh Duyệt
Nếu dùng từ khóa Array, chỉ trả về mảng chỉ có một chiều nếu muốn trả về một mảng hai chiều chúng ta phải dùng Array(Array(…))

cảm ơn anh Nghĩa đẹp trai đã giúp đỡ nhiệt tình

ndu96081631 · 6/8/16

manggpe đã viết:
em muốn gán mảng 2 chiều theo yêu cầu này mà không được?

Mã:

Dim Arr() Dim AB As Long Arr = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12)) MsgBox Arr(1)(1)

em chỉ làm được như vậy thôi, mà như vậy thì nó là mảng một chiều trong mảng một chiều?
có cách nào gán mảng 2 chiều trực tiếp bằng array?

Tôi thường làm thế này:

Mã:

Sub Test2()
  Dim arr
  arr = [{1,2,3;4,5,6;7,8,9;10,11,12}]
  Range("A1:C4").Value = arr
End Sub

Thử xem.. hên thì được còn xui thì.. thôi vậy!

manggpe · 6/8/16

ndu96081631 đã viết:
Tôi thường làm thế này:

Mã:

Sub Test2() Dim arr arr = [{1,2,3;4,5,6;7,8,9;10,11,12}] Range("A1:C4").Value = arr End Sub

Thử xem.. hên thì được còn xui thì.. thôi vậy!

cảm ơn anh ndu, xem như đã giải quyết được 1 yêu cầu rồi, cảm ơn anh ndu nhiều, tuy rằng những cái vấn đề này nó không quan trọng lắm nhưng mà em muốn biết tường tận để thỏa lòng thỏa dạ

Hoàng Trọng Nghĩa · 6/8/16

manggpe đã viết:
ý em muốn biết là mình có khai báo tường minh mảng con trong mảng mẹ hay không thôi? và cách truy xuất và gán giá trị ?
và vấn đề thứ nhất của em Array đúng là mảng một chiều, nhưng em có đọc bài anh Lê Văn Duyệt có nói là làm được nên em muốn tò mò xem sao thôi.
Nguyên văn bài của anh Duyệt
Nếu dùng từ khóa Array, chỉ trả về mảng chỉ có một chiều nếu muốn trả về một mảng hai chiều chúng ta phải dùng Array(Array(…))
cảm ơn anh Nghĩa đẹp trai đã giúp đỡ nhiệt tình

Tôi không nghĩ với cách màu đỏ lại trở thành mảng 2 chiều được!

manggpe · 6/8/16

Hoàng Trọng Nghĩa đã viết:
Tôi không nghĩ với cách màu đỏ lại trở thành mảng 2 chiều được!

Dạ cái đó là hên suôi, em cũng thử chưa ra, nhưng đọc bài của anh Duyệt thấy như vậy nên tò mò thôi anh, tò mò hoài không ra nên hỏi xem có đáp án nào không.

Hoàng Trọng Nghĩa · 6/8/16

manggpe đã viết:
Dạ cái đó là hên suôi, em cũng thử chưa ra, nhưng đọc bài của anh Duyệt thấy như vậy nên tò mò thôi anh, tò mò hoài không ra nên hỏi xem có đáp án nào không.

Vậy bạn đọc nó ở đâu? Bạn cho cái link đến đó để tôi nghiên cứu xem sao!

manggpe · 6/8/16

Hoàng Trọng Nghĩa đã viết:
Vậy bạn đọc nó ở đâu? Bạn cho cái link đến đó để tôi nghiên cứu xem sao!

https://bugatino17.wordpress.com/2014/03/21/lam-viec-voi-mang-trong-vba/
gần cuối trang nha anh

VetMini · 7/8/16

Theo nghĩa rộng thì mảng của mảng có thể coi là mảng 2 chiều.
Theo nghĩa chính thức của lập trình thì mảng 2 chiều phải hội đủ 2 điều kiện sau:
1. các phần tử phải cùng một kiểu (type)
2. các phân tử phải liên tục nhau.

cái mảng này:
Arr = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12))

Khong BẢO ĐẢM 2 điều kiên trên. Vì vậy, theo định nghĩa của lập trình, nó khong phải là mảng 2 chiều.
Một số ngôn ngữ gọi nó là mảng răng cưa (jagged array).

Kiều Mạnh · 11/8/16

Các Bạn cho mình hỏi có cách nào khác duyệt File như code sau ngắn gọn hơn Mà không sử dụng Array

mà vẫn duyệt được không ... xin cảm ơn

Mã:

[/B]Sub CheckFile() Dim MyFile(), i As Long MyFile = [COLOR=#ff0000][B]Array[/B][/COLOR]("x1.xls", "x2.xlsb", "x3.xlsx") For i = 0 To UBound(MyFile) MsgBox MyFile(i) Next End Sub [B]

VetMini · 12/8/16

kieu manh đã viết:
Các Bạn cho mình hỏi có cách nào khác duyệt File như code sau ngắn gọn hơn Mà không sử dụng Array

mà vẫn duyệt được không ... xin cảm ơn

Mã:

Mã:

Sub CheckFile() Dim MyFile(), i As Long MyFile = [COLOR=#ff0000][B]Array[/B][/COLOR]("x1.xls", "x2.xlsb", "x3.xlsx") For i = 0 To UBound(MyFile) MsgBox MyFile(i) Next End Sub

Khong dùng Array? bạn muốn nói hàm Array?

for each f in split("x,y,z", ",")

Kiều Mạnh · 12/8/16

VetMini đã viết:
Khong dùng Array? bạn muốn nói hàm Array?

for each f in split("x,y,z", ",")

Chi tiết là vầy ...Nếu ta có 100 File ở nhiều Folder khác nhau thì Cái Array thấy dài quá ...

Vậy mình đang nghĩ có cách nào viết khác mà không phải xài Array cho nó gọn lại đó mà ...mà mục đích cũng vậy

Và cách khai báo này thấy hoài nên cũng đang nghĩ xem khai phá cách viết mới xúc tích ngắn gọn và dễ xài hơn không

Mã:

Private Sub CheckFile1()
    Dim MyFile(), i As Long
    Dim File1 As String, File2 As String, File3 As String
    File1 = "D:\Manh\x1.xls"
    File2 = "E:\Anh\x2.xlsb"
    File3 = "C:\XX\x3.xlsx"
    MyFile = [COLOR=#ff0000][B]Array[/B][/COLOR](File1, File2, File3)
    For i = 0 To UBound(MyFile)
        MsgBox MyFile(i)
    Next
End Sub

pjsoga · 12/8/16

Chào các bác.
Các bác có thể chuyển dữ liệu tử vùng 1 sang vùng 2 như att file giúp em được ko ạ
Em xin cảm ơn!

pjsoga · 13/8/16

Cám ơn bác rất nhiều. Nhưng lần này em có yêu cầu còn khó hơn nhiều, mong bác lại giúp đỡ. ^^ --=0

pjsoga · 15/8/16

Chờ đợi 2 ngày mà không có cao thủ nào bớt chút thời gian giúp em ah? **~**

HieuCD · 15/8/16

pjsoga đã viết:
Chờ đợi 2 ngày mà không có cao thủ nào bớt chút thời gian giúp em ah?

bạn giải thích kết quả cột code ở bảng bên phải nhất là của thằng a

kegiaumat · 16/8/16

Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

HieuCD · 16/8/16

kegiaumat đã viết:
Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

bạn cho file ví dụ và đưa code lên, mọi người sẽ góp ý

pjsoga · 16/8/16

Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3)

pjsoga · 16/8/16

Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3

HieuCD · 16/8/16

pjsoga đã viết:
Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3

bạn giải thích rỏ về a qua tất cả các bảng, nó không cùng qui luật với b và c

pjsoga · 17/8/16

Hi, sorry bạn. Mình diễn giải nhầm mất 1 chút của a lần 2. Mình chỉnh sửa lại rồi nhé.
Giá trị xuất lần 1 giữ nguyên, lần 2 thêm vào ô bên dưới cuối cùng của lần 1, lần n thêm vào ô bên dưới của ô n-1. ( Cọt I)
Rất cảm ơn bạn đã quan tâm!

HieuCD · 18/8/16

pjsoga đã viết:
Hi, sorry bạn. Mình diễn giải nhầm mất 1 chút của a lần 2. Mình chỉnh sửa lại rồi nhé.
Giá trị xuất lần 1 giữ nguyên, lần 2 thêm vào ô bên dưới cuối cùng của lần 1, lần n thêm vào ô bên dưới của ô n-1. ( Cọt I)
Rất cảm ơn bạn đã quan tâm!

bạn xem file đúng ý chưa

SA_DQ · 18/8/16

Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã.
E muốn kiểm tra các mã có trong cột A ko có trong cột B và C;
có trong cột B ko có trong cột A và C;
có trong cột C mà ko có trong cột A và B
sau đó ghi ra cột D E F.

Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

Mình fải mất hơn 2H để giả lập file cho bạn; Thế mới biết chưa ai trả lời cho bạn trước mình!

& với chương trình này, máy mình chạy dưới 9 gy.

quanluu · 18/8/16

kegiaumat đã viết:
Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

bạn cho hỏi, nếu cột A có nhiều mã trùng nhau mà không có trong cột B, C thì để nguyên hay chỉ lấy 1? nếu lấy duy nhất thì bạn hoàn toàn có thể làm thủ công nhé.

pjsoga · 18/8/16

Chuẩn luôn. Cám ơn bạn rất nhiều. Nhưng nhìn đoạn mã hoa cả mắt, chắc châm cứu ốm xác mới hiểu đc phần nào. ^^

pjsoga · 13/10/16

Topic này như bị đóng băng hay sao mà ko có ai hỏi nữa nhỉ? ^^
Nay mình có 2 vấn đề khó lại phiền các cao thủ xuất sơn trợ giúp
Vấn đề 1. Mình nên yêu cầu trong file
Vấn đề 2: Mình cũng nêu trong file
Cả 2 vấn đề chắc cũng tốn không ít thời gian của các bác, mình xin cảm ơn nhiều.

Let'GâuGâu · 13/10/16

pjsoga đã viết:
Topic này như bị đóng băng hay sao mà ko có ai hỏi nữa nhỉ? ^^
Nay mình có 2 vấn đề khó lại phiền các cao thủ xuất sơn trợ giúp
Vấn đề 1. Mình nên yêu cầu trong file
Vấn đề 2: Mình cũng nêu trong file
Cả 2 vấn đề chắc cũng tốn không ít thời gian của các bác, mình xin cảm ơn nhiều.

đây yêu cầu file "Array"

Mã:

Option Explicit

Sub test()
Dim sRange As Range
Dim rArr(1 To 6000, 1 To 4) As Variant

Dim i, j, k As Long
Set sRange = Range("A2:H7")
rArr(1, 1) = "Date": rArr(1, 2) = "Cells": rArr(1, 3) = "Tittle": rArr(1, 4) = "Font"
k = 1
For i = 3 To sRange.Rows.Count
    For j = 3 To sRange.Columns.Count
    With sRange
        If .Cells(i, j) Like "*.XX" Then
            k = k + 1
            rArr(k, 1) = .Cells(i, 1): rArr(k, 2) = .Cells(i, j)
            rArr(k, 3) = .Cells(1, j)
            If .Cells(i, j).Font.ColorIndex = 3 Then rArr(k, 4) = "Do" Else rArr(k, 4) = "Den"
        End If
    End With
    Next
Next
If k Then
    [a15:d1000].Clear
    [a15].Resize(k, 4) = rArr
End If
End Sub

====
yêu cầu ở file nén của bạn là gì vậy? copy các file ở folder 1-->n về file tổng hợp

doveandrose · 13/10/16

Let'GâuGâu đã viết:
yêu cầu ở file nén của bạn là gì vậy? copy các file ở folder 1-->n về file tổng hợp

dạ yêu cầu trong file nén đây ạ , anh giúp em với !$@!!

Let'GâuGâu · 13/10/16

doveandrose đã viết:
dạ yêu cầu trong file nén đây ạ , anh giúp em với

dạ, em định dzọc bằng ADO
vba không còn hứng nữa.......nhưng có được hay không còn hên xui......mà chắc xui nhiều hơn quá.......hihihihi

Let'GâuGâu · 13/10/16

pjsoga đã viết:
Topic này như bị đóng băng hay sao mà ko có ai hỏi nữa nhỉ? ^^
Nay mình có 2 vấn đề khó lại phiền các cao thủ xuất sơn trợ giúp
Vấn đề 1. Mình nên yêu cầu trong file
Vấn đề 2: Mình cũng nêu trong file
Cả 2 vấn đề chắc cũng tốn không ít thời gian của các bác, mình xin cảm ơn nhiều.

yêu cầu 2, coppy về file tổng hợp
làm thử coppy file folder 1
nếu đúng thì sẻ làm tiếp (thử thêm một vòng lặp), không đúng thì chạy luộn.....hihiih........đi ngủ đây........đến giờ lên giường rồi

Mã:

Option Explicit
Dim SourceFile As String
Public Sub GetLastedUpDateFile()
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim LastedDate As Date
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder("C:\Users\Dell optiplex 380\Desktop\test\Folder 1") 'doi lai thu muc

    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files
            If oFile.DateLastModified > LastedDate Then LastedDate = oFile.DateLastModified: SourceFile = oFile
        Next oFile
    Loop
    Copy_Range (SourceFile)
End Sub
Sub Copy_Range(SourceFile)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect, SourceSheet, SourceRange As String
    Dim szSQL As String
    Dim lCount As Long
 
  SourceSheet = "Sheet1"
  SourceRange = "A3:B60000"
    
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
    szSQL = "SELECT * FROM [" & SourceSheet & "$" & SourceRange$ & "]"
    
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    
    If Not rsData.EOF Then
        [a1].End(4).Offset(1).CopyFromRecordset rsData
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing


End Sub

============
đợi bạn test lâu quá, chỉnh lại code luôn nè

Mã:

Option Explicit
Dim SourceFile As String
Public Sub GetLastedUpDateFile()
    Dim fso, oFolder, oSubfolder, oFile, FolderList As Collection
Dim LastedDate As Date
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FolderList = New Collection
    FolderList.Add fso.GetFolder("D:\NAM\test") 'doi lai thu muc

    Do While FolderList.Count > 0
        Set oFolder = FolderList(1)
        FolderList.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            For Each oFile In oSubfolder.Files
                If oFile.DateLastModified > LastedDate Then LastedDate = oFile.DateLastModified: SourceFile = oFile
            Next oFile
            Copy_Range (SourceFile)
        Next oSubfolder
    Loop
   
End Sub
Sub Copy_Range(SourceFile)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect, SourceSheet, SourceRange As String
    Dim szSQL As String
    Dim lCount As Long
 
  SourceSheet = "Sheet1"
  SourceRange = "A3:B60000"
    
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
    szSQL = "SELECT * FROM [" & SourceSheet & "$" & SourceRange$ & "]"
    
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    
    If Not rsData.EOF Then
        [a6000].End(3).Offset(1).CopyFromRecordset rsData
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing


End Sub

pjsoga · 16/10/16

Thanks bác nhiều! Nhưng vấn đề 1 em còn điều kiện VietNam không thấy bác nêu
Vấn đề 2 chạy cho Folder 1 nhưng chạy lặp lại 3 lần?

Let'GâuGâu · 16/10/16

pjsoga đã viết:
Vấn đề 2 chạy cho Folder 1 nhưng chạy lặp lại 3 lần?

bạn lấy đoạn code nào chạy vậy?
nhớ khai báo lại đường dẫn nha

huyendhxd · 16/11/16

Chào các bác!!!
Em mới tập làm VBA, em đang viết hàm nội suy cho một bảng như hình

Va duoi day la code em moi viet
Public Function Noisuy(x As Double, y As Double) As Double
Dim Dulieu(7, 7) As Double, chieu1(7, 1) As Double, chieu2(1, 7) As Double
Dim x1 As Double, x2 As Double
Dim i As Integer, j As Integer
Dim dl As Range, c1 As Range, c2 As Range
Set dl = Range("B2:H8").Value2
Set c1 = Range("A2:A8").Value2
Set c2 = Range("B1:H1").Value2
Dulieu = Range("B2:H8")
chieu1 = Range("A2:A8")
chieu2 = Range("B1:H1")
For i = 1 To 7
For j = 1 To 7
Dulieu(i, j) = dl.Cells(i, j).Value
chieu1(i, 1) = c1.Cells(i, 1).Value
chieu2(1, j) = c2.Cells(1, j).Value
Next
Next
For i = 1 To UBound(chieu1, 1) - 1 Step 1
For j = 1 To UBound(chieu2, 2) - 1 Step 1
If x >= chieu1(i, 1) And x <= chieu1(i + 1, 1) And y >= chieu2(1, j) And y <= chieu2(1, j + 1) Then
x1 = Dulieu(i, j) + (Dulieu(i + 1, j) - Dulieu(i, j)) / (chieu1(i + 1, 1) - chieu1(i, 1)) * (x - chieu1(i, 1))
x2 = Dulieu(i, j + 1) + (Dulieu(i + 1, j + 1) - Dulieu(i, j + 1)) / (chieu1(i + 1, 1) - chieu1(i, 1)) * (x - chieu1(i, 1))
Noisuy = x1 + (x2 - x1) / (chieu2(1, j + 1) - chieu2(1, j)) * (y - chieu2(1, j))
Else: MsgBox "Chon lai gia tri"
Next
Next
End Function

Vấn đề là sau khi viết xong thì không dùng được --=0

Bác nào vui lòng chỉ giáo cho em với ạ.

Em xin cảm ơn nhiều ạ.

huyendhxd · 16/11/16

Xin gửi các bác cái hình có bảng. Em quên mất

langtuchungtinh360 · 19/2/17

Hỏi về khai báo mảng lồng

mọi người cho em hỏi vấn đề thế này
ví dụ như ta khai báo
Arr(2) => Arr(0), Arr(1), Arr(2)
rồi Arr(0) = range("A1:A3")
rồi Arr(1) = range("B1:B3")
rồi Arr(2) = range("C1:C3")
thì ta được 1 mảng lồng ghép với nhau
là Arr(0)(1,1)
Arr(0)(2,1)
Arr(0)(3,1)
......< chỗ này không biết đúng ko nữa>
vậy cho em hỏi
ta có thể khai báo kích thước của Arr(0) lại Arr(0) (0 to 10)
cái chỗ màu đỏ đó có được không, và khai báo lại thế nào vậy ạ

VetMini · 19/2/17

langtuchungtinh360 đã viết:
ta có thể khai báo kích thước của Arr(0) lại Arr(0) (0 to 10)
cái chỗ màu đỏ đó có được không, và khai báo lại thế nào vậy ạ

Lý do tại sao muốn làm thế?

langtuchungtinh360 · 19/2/17

VetMini đã viết:
Lý do tại sao muốn làm thế?

học hỏi thêm thôi mà bác. với có việc cần dùng đến nó nên hỏi vậy mà. /-*+/

VetMini · 20/2/17

langtuchungtinh360 đã viết:
học hỏi thêm thôi mà bác. với có việc cần dùng đến nó nên hỏi vậy mà.

Có đến vài cách thực hiện. Tôi hỏi lý do là để dùng cách đúng nhất. Trả lời khơi khơi thế lấy gì mà mò.
Thôi nhường người khác vậy.

langtuchungtinh360 · 20/2/17

VetMini đã viết:
Có đến vài cách thực hiện. Tôi hỏi lý do là để dùng cách đúng nhất. Trả lời khơi khơi thế lấy gì mà mò.
Thôi nhường người khác vậy.

học hỏi thêm thì không chỉ được sao bác @@
tại có vấn đề thế này

ví dụ em muốn chèn giá trị của mảng vào A1

10
khai báo C1: Arr(3) thì được 4 giá trị tương đương 4 cột (ở đây do số cột không cố định nên không thể khai báo nhiều mảng được nên em nghĩ cách dùng mảng thế này thì số cột thay đổi linh động hơn.) tương đương 1 Arr(x) là 1 mảng (rõ hơn xin đọc tiếp)
---------------------------------------------------------------------------------------------------------------
rồi lý do tại sao lại làm như thế mà không dùng C2: Arr(1 to x, 1 to y) - y cột x dòng (đơn giản)
là do em chỉ muốn điền kết quả theo cột chứ không điền nguyên mảng xuống cells
---------------------------------------------------------------------------------------------------------------
vì sao lại muốn như thế ? => ví dụ như em muốn điền xuống A1

10
và ở cột C1:C10 lại có công thức
nếu như dùng C2 thì cột C sẽ mất đi công thức nên em muốn dùng theo C1 là điền từng mảng xuống cho cột A, B, D, vì vậy công thức tại cột C sẽ không mất
em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

VetMini · 20/2/17

langtuchungtinh360 đã viết:
em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

Trình độ về tài nguyên của tôi chỉ biết đến việc dùng mảng tĩnh (fixed size & predeclared type) sẽ được một vùng nhớ liên tục và do đó hiệu quả hơn mảng động.
Còn việc tốn tài nguyên cho mảng tạm có ảnh hưởng đến chạy code hay không thì quá mức hiểu biết của tôi.

Ngoài ra, theo trường phái học của tôi thì việc tốn bộ nhớ chỉ quan trọng khi người ta viết hàm gọi nhau liên tục, và nhất là hàm đệ quy, vì bộ nhớ ngăn xếp có giới hạn. Chứ code chạy chỉ một hàm duy nhất thì vài cái mảng hàng chục triệu bytes chả có nghĩa lý gì cả.

VetMini · 20/2/17

langtuchungtinh360 đã viết:
học hỏi thêm thì không chỉ được sao bác @@...

Tôi đã quen với cái tật hỏi úp úp mở mở của quý vị.
Ở trên tôi nói rõ "có vài cách làm". Nếu tôi không hỏi ngược lại thì làm sao quý vị tiết lộ ra là mình đã biết 1 cách, nhưng còn chê nó dở.

ndu96081631 · 20/2/17

langtuchungtinh360 đã viết:
nếu như dùng C2 thì cột C sẽ mất đi công thức

Nếu bạn dung thuộc tính Formula thì sẽ không mất công thức (arr = Range(...).Formula)

------------------------------------

langtuchungtinh360 đã viết:
nên em muốn dùng theo C1 là điền từng mảng xuống cho cột A, B, D, vì vậy công thức tại cột C sẽ không mất
em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

Tôi cũng thường dùng cách 1, vèo cái là xong chứ có gì đâu mà tốn tài nguyên

tueyennhi · 24/2/17

Em có code sau:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then

Code này có thể viết thành dạng Resize được không ạ? Em viết như này thì báo lỗi:

If Arr(J, 7).Resize(Rws, 3) then

Gió Đông · 24/2/17

tueyennhi đã viết:
Em có code sau:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then

Code này có thể viết thành dạng Resize được không ạ? Em viết như này thì báo lỗi:

If Arr(J, 7).Resize(Rws, 3) then

Không, tại sao thì bạn tự suy nghĩ xem cho hiểu sâu và đúng hơn vì tôi không biết Arr thuộc loại biến gì(?)

tueyennhi · 24/2/17

Arr là mảng winvista
Rws = Range("C65536").End(xlUp).Row

Arr() = [E9].Resize(Rws, 9).Value
ReDim dArr(1 To Rws, 1 To 2)
For J = 1 To UBound(Arr())

befaint · 24/2/17

@tueyennhi,

Nếu Dim Arr() As Variant
thì có thể viết:
if Arr(J, 7) + Arr(J, 8) + Arr(J, 9) = empty then

Resize là thuộc tính của range.
range.resize()

tueyennhi · 24/2/17

Vậy thì chắc không có cách viết nào khác mà xử lý dữ liệu nhanh hơn cách viết này mọi người nhỉ:

PHP:

 If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then
        dArr(J, 2) = ""
 ElseIf Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "" Then
        dArr(J, 2) = ""
 Else
        dArr(J, 2) = 1
 End If

Code trên để check sự tồn tại dữ liệu ở 3 ô. Nếu tất cả đều có dữ liệu hoặc không có dữ liệu thì ra giá trị ""
Còn lại là giá trị 1

Gió Đông · 24/2/17

Viết kiểu này cho đơn giản (vì không biết dữ liệu Arr chắc chắn là dạng sô hay text?)

PHP:

if (Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "") or (Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "") then 
   dArr(J, 2) = ""
else:   dArr(J, 2) = 1   : End If

còn nhanh hay chóng thì quan trọng gì khi dữ liệu có vài ngàn dòng, khi nào dữ liệu cực lớn (hàng chục triệu) thì mới quan tâm nhanh chậm, thêm nữa nhanh chậm vẫn quan trọng thuật toán tổng thể gốc , há chi mấy con kiến nhỏ này

VetMini · 24/2/17

tueyennhi đã viết:
Vậy thì chắc không có cách viết nào khác mà xử lý dữ liệu nhanh hơn cách viết này mọi người nhỉ:

PHP:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then dArr(J, 2) = "" ElseIf Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "" Then dArr(J, 2) = "" Else dArr(J, 2) = 1 End If

Code trên để check sự tồn tại dữ liệu ở 3 ô. Nếu tất cả đều có dữ liệu hoặc không có dữ liệu thì ra giá trị ""
Còn lại là giá trị 1

Code trước khi bạn sửa nhanh hơn, tuy nó trông rườm rà hơn.
VBA khong có tính chất xét biểu thức một cách thong minh. Khi gặp If (biểu thức 1) And (biểu thức 2) And (biểu thức 3) thì nó phải tính đủ cả 3 biểu thức. Khác với nhiều ngôn ngữ sau này (PHP chẳng hạn) xét theo kiểu thong minh, nếu (biểu thức 1) không thoả thì nó tự động biết không xét đến (biểu thức 2)
Vì vậy trường hợp nhiều điều kiện đặt lồng vào nhau chạy nhanh hơn dùng And

tueyennhi · 24/2/17

VetMini đã viết:
Code trước khi bạn sửa nhanh hơn, tuy nó trông rườm rà hơn.
VBA khong có tính chất xét biểu thức một cách thong minh. Khi gặp If (biểu thức 1) And (biểu thức 2) And (biểu thức 3) thì nó phải tính đủ cả 3 biểu thức. Khác với nhiều ngôn ngữ sau này (PHP chẳng hạn) xét theo kiểu thong minh, nếu (biểu thức 1) không thoả thì nó tự động biết không xét đến (biểu thức 2)
Vì vậy trường hợp nhiều điều kiện đặt lồng vào nhau chạy nhanh hơn dùng And

Ừm nhưng không hiểu sao nó lại sai không đúng bằng cái này.

tueyennhi · 24/2/17

winvista đã viết:
Viết kiểu này cho đơn giản (vì không biết dữ liệu Arr chắc chắn là dạng sô hay text?)

PHP:

if (Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "") or (Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "") then dArr(J, 2) = "" else: dArr(J, 2) = 1 : End If

còn nhanh hay chóng thì quan trọng gì khi dữ liệu có vài ngàn dòng, khi nào dữ liệu cực lớn (hàng chục triệu) thì mới quan tâm nhanh chậm, thêm nữa nhanh chậm vẫn quan trọng thuật toán tổng thể gốc , há chi mấy con kiến nhỏ này

. Tại thấy các anh trên này toàn tốc độ 0,0..mấy giây mà mình thì toàn mất gần 1s

(. Nên ham hố

huuthang_bd · 24/2/17

tueyennhi đã viết:
Vậy thì chắc không có cách viết nào khác mà xử lý dữ liệu nhanh hơn cách viết này mọi người nhỉ:

PHP:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then dArr(J, 2) = "" ElseIf Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "" Then dArr(J, 2) = "" Else dArr(J, 2) = 1 End If

Code trên để check sự tồn tại dữ liệu ở 3 ô. Nếu tất cả đều có dữ liệu hoặc không có dữ liệu thì ra giá trị ""
Còn lại là giá trị 1

Vầy có lẽ nhanh hơn

PHP:

If Arr(J, 7) = "" Xor Arr(J, 8) = "" Then
    dArr(J, 2) = 1
ElseIf Arr(J, 7) = "" Xor Arr(J, 9) = "" Then
    dArr(J, 2) = 1
Else
    dArr(J, 2) = ""
End If

Có thể chỗ cẫn tối ưu không phải là chỗ này

VetMini · 24/2/17

tueyennhi đã viết:
Ừm nhưng không hiểu sao nó lại sai không đúng bằng cái này.

Bạn viết code không có chú thích (comments). Tôi đâu có biết bạn muón làm gì đâu mà nói chuyện đúng sai.
Vì bạn đề cập chuyện "nhanh" cho nên tôi chỉ ra cách cấu trúc dòng code thôi.

tueyennhi · 24/2/17

huuthang_bd đã viết:
Vầy có lẽ nhanh hơn

PHP:

If Arr(J, 7) = "" Xor Arr(J, 8) = "" Then dArr(J, 2) = 1 ElseIf Arr(J, 7) = "" Xor Arr(J, 9) = "" Then dArr(J, 2) = 1 Else dArr(J, 2) = "" End If

Có thể chỗ cẫn tối ưu không phải là chỗ này

Cảm ơn huuthang_bd , code đáp ứng được yêu cầu. Có nhanh hơn một chút và quan trọng là mình lại học thêm được một vài thứ

. Đúng như bạn nói, còn nhiều cái mình biết là có thể làm cho nhanh hơn nhưng code của mình dài, cũng đã nhờ mọi người xem nhưng nhọc quá nên mình vẫn phải hỏi một vài vấn đề một, hi hi.

Ví dụ code này mất thời gian hơn 1/3 tất cả các code khác: Mình phải dùng một dòng phụ để định dạng các cột có chủ định, dựa vào dòng này định dạng cho toàn bộ trang tính.

[A5].Resize(, 45).Copy
[A9].Resize(Rws, 45).PasteSpecial Paste:=xlPasteFormats

Hoặc cái này

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Rất tốn thời gian, nhưng không cho không được vì nếu không nó update cả công thức cũng chết

(

tueyennhi · 24/2/17

VetMini đã viết:
Bạn viết code không có chú thích (comments). Tôi đâu có biết bạn muón làm gì đâu mà nói chuyện đúng sai.
Vì bạn đề cập chuyện "nhanh" cho nên tôi chỉ ra cách cấu trúc dòng code thôi.

Hi hi, mình có ghi là Code trên để check sự tồn tại dữ liệu ở 3 ô. Nếu tất cả đều có dữ liệu hoặc không có dữ liệu thì ra giá trị ""
Còn lại là giá trị 1. Mà

Gió Đông · 24/2/17

tueyennhi đã viết:
Cảm ơn huuthang_bd , code đáp ứng được yêu cầu. Có nhanh hơn một chút và quan trọng là mình lại học thêm được một vài thứ . Đúng như bạn nói, còn nhiều cái mình biết là có thể làm cho nhanh hơn nhưng code của mình dài, cũng đã nhờ mọi người xem nhưng nhọc quá nên mình vẫn phải hỏi một vài vấn đề một, hi hi.
Ví dụ code này mất thời gian hơn 1/3 tất cả các code khác: Mình phải dùng một dòng phụ để định dạng các cột có chủ định, dựa vào dòng này định dạng cho toàn bộ trang tính.

[A5].Resize(, 45).Copy
[A9].Resize(Rws, 45).PasteSpecial Paste:=xlPasteFormats

Tôi có lần xem cái code đó rui, bạn nên vứt cái dòng phụ đó đi, và xóa bỏ cái đoạn code format đó đi sẽ nhanh thôi, vì

+ Không phải lúc nào cũng format lại bảng tính thế, vì format rui lại format lại ah

+ nên làm 1 sub riêng về format, gắn với button chỉ chạy khi cần, không chạy cùng chương trình tính toán chính: định dạng luôn là luôn format thêm 200 dòng (dòng trắng dưới của bảng) nữa chẳng hạn hoặc cho chọn định dạng toàn bảng và thêm 200 dòng nữa ...

như thế code chính mới nhằm vào mục đích chính là tính toán không phải format, không phải để sẵn 1 dòng thừa như thế (luôn lấy dòng 1 làm chuẩn là đủ). CÒn 3 cái and or này, cứ thử test đi, nhanh chậm không đáng kể, so với format ngoài bảng tính số lượng dòng nhiều.

tueyennhi · 24/2/17

winvista đã viết:
Tôi có lần xem cái code đó rui, bạn nên vứt cái dòng phụ đó đi, và xóa bỏ cái đoạn code format đó đi sẽ nhanh thôi, vì

+ Không phải lúc nào cũng format lại bảng tính thế, vì format rui lại format lại ah

+ nên làm 1 sub riêng về format, gắn với button chỉ chạy khi cần, không chạy cùng chương trình tính toán chính: định dạng luôn là luôn format thêm 200 dòng (dòng trắng dưới của bảng) nữa chẳng hạn hoặc cho chọn định dạng toàn bảng và thêm 200 dòng nữa ...

như thế code chính mới nhằm vào mục đích chính là tính toán không phải format, không phải để sẵn 1 dòng thừa như thế (luôn lấy dòng 1 làm chuẩn là đủ). CÒn 3 cái and or này, cứ thử test đi, nhanh chậm không đáng kể, so với format ngoài bảng tính số lượng dòng nhiều.

Ừm nhỉ, vẫn biết là để chấm công hoàn chỉnh thì phải kiểm tra và chạy đi chạy lại các khâu không cần thiết mà mình không nghĩ ra bỏ phần ấy thành sub riêng. Quả nhiên tốc độ đã tăng lên đáng kể.

.

tueyennhi · 11/4/17

Cho em hỏi về code mảng sau:

PHP:

J = Sheets("100H").Range("F3").Value
With Sheets("OVT")
sArr = .Range("B4", .Range("B4").End(xlDown)).Resize(, 60).Value
    For I = 1 To UBound(sArr)
        If sArr(I, 59) >= J Then
            dArr(I, 1) = sArr(I, 1)
            dArr(I, 2) = sArr(I, 2)
            dArr(I, 3) = sArr(I, 3)
            dArr(I, 4) = sArr(I, 4)
            dArr(I, 5) = sArr(I, 59)
        End If
    Next I
End WithSheets("100H").Range("B5").Resize(I, 5) = dArr

Code với điều kiện lọc lấy giá trị mà lớn hơn giá trị trong F3. Tuy lọc thì được rồi nhưng chạy code em thấy mặc định các giá trị nào không thỏa mãn thì nó vẫn gán vào mảng với giá trị là ô trống. Như vậy dữ lieu sẽ không liền mà bị cách nhau. Có cách nào xử lý không ạ?

tueyennhi · 11/4/17

hpkhuong đã viết:

Thêm 1 biến K nữa. Có nghĩa là:

Mã:

[COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]59[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) >= [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]J Then
     K= K+1
     dArr(K,1) = sArr(I,1)
     .....
End if
....
[/FONT][/COLOR][COLOR=#0000bb][FONT=monospace][I]Sheets[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#dd0000][FONT=monospace][I]"100H"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000bb][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#dd0000][FONT=monospace][I]"B5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000bb][FONT=monospace][I]Resize[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][FONT=monospace][I][COLOR=#0000bb]K[/COLOR][/I][/FONT][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000bb][FONT=monospace][I]5[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000bb][FONT=monospace][I]dArr  [/I][/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]
....
[/FONT][/COLOR]

Hay quá, cảm ơn bạn rất nhiều!

tueyennhi · 12/4/17

Cho em hỏi ạ. Bình thường trong Excel ta có hàm cơ bản là vlookup để lấy số liệu mà ta muốn, vậy trong VBA ta làm như nào.
Giả sử:

Ô A1 chứa giá trị A101;
Ô C1 và C2 chứa giá trị tương ứng là A101, A102;
Ô D1 và D2 chứa giá trị tương ứng là 100 và 200;

Vậy viết code nào để giá trị gán vào ô B1 sẽ là 100???

Em thử sử dung Find để chơi nhưng mới chỉ loáng thấy cái gì đó chứ chưa phải cái cần tìm

PHP:

With Sheets("TT")
sArr = .Range("A5", .Range("A5").End(xlDown)).Resize(, 25).Value
For I = 1 To UBound(sArr)
     dArr(I, 1) = Range("N5:O20").Find(sArr(I, 5))
Next I
End With

Hiện tại nó lấy giá trị ở cột N, em muốn lấy giá trị tương ứng ở cột O thì em phải làm như nào ?

tueyennhi · 13/4/17

À em làm được rồi, đúng là không có cơ bản thì cái đơn giản cũng phải tìm hiểu @@

PHP:

dArr(I, 1) = Range("N5:O20").Find(sArr(I, 5)).Offset(, 1)

ChanhTQ@ · 13/4/17

PHP:
À em làm được rồi, đúng là không có cơ bản thì cái đơn giản cũng phải tìm hiểu @@

PHP:

dArr(I, 1) = Range("N5:O20").Find(sArr(I, 5)).Offset(, 1)

Lệnh này tiềm ẩn nguy cơ lớn về lâu dài!
Với phương thức FIND() cần bẩy lỗi bạn à!

tueyennhi · 13/4/17

ChanhTQ@ đã viết:
Lệnh này tiềm ẩn nguy cơ lớn về lâu dài!
Với phương thức FIND() cần bẩy lỗi bạn à!

Em vừa dính lỗi nếu trong vùng tìm kiếm không có giá trị mình tìm xong @@. Em chỉ muốn bẫy lỗi ở dòng dArr(I, 1) = Range("N5:O20").Find(sArr(I, 5)).Offset(, 1) thì để như vậy được chưa ạ?

Em sửa thành như vầy không biết có tiềm ẩn gì nữa không:

PHP:

With Sheets("TT")
sArr = .Range("A5", .Range("A5").End(xlDown)).Resize(, 25).Value
For I = 1 To UBound(sArr, 1)
On Error Resume Next
    dArr(I, 1) = Range("N5:O20").Find(sArr(I, 5)).Offset(, 1)
Next I

For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 5)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 10)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 10)
    End If
Next I

For I = 1 To UBound(sArr, 1)
    pArr(I, 1) = Dic.Item(sArr(I, 5))
Next I

For I = 1 To UBound(sArr, 1)
    tArr(I, 1) = Round(dArr(I, 1) / pArr(I, 1) * sArr(I, 10), 2)
Next I

[K5].Resize(I - 1) = tArr

Set Dic = Nothing
End With

phuyen89 · 21/5/17

ndu96081631 đã viết:
Code của bạn chưa phải là mảng. Đoạn này If Cells(li, 1).Value = "111250000125" Then vẫn xem như chưa "thoát ly" khỏi Range đâu (vì phải dựa vào Cells(li, 1) ). Vì thế tốc độ vẫn chậm
Tôi sửa lại như sau:

PHP:

Sub hocmang() Dim Arr() As String, sArray, li As Long, lj As Long sArray = Range("A1:A808945").Value ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(sArray, 2)) For li = 1 To UBound(sArray, 1) If sArray(li, 1) = "111250000125" Then lj = lj + 1 Arr(lj, 1) = sArray(li, 1) End If Next li Range("E1").Resize(lj).Value = Arr End Sub

- Thứ nhất: Không cần Option Base 1 gì cả, khai báo trực tiếp rằng ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
- Thứ hai: Dim Arr() As String sẽ bảo đảm kết quả luôn là chuổi
- Thứ ba: Chổ này arr(UBound(sarr, 1), LBound(sarr, 1)) xem bộ không chuẩn (phải giống cái trên mới đúng)
Thử lại code tôi vừa đưa ở trên xem tốc độ thế nào
---------------------------------------------------------------------------------

Không biết báo lỗi copy với dữ liệu lọc bằng AutoFilter hay với code? ---> Đoán là báo lỗi khi copy dữ liệu sau AutoFilter! Điều này rất bình thường. SpecialCells sẽ có giới hạn với dữ liệu lớn ---> Nếu dùng Filter thì nên chuyển sang Advanced Filter, sẽ hết lỗi liền (vì không phải copy, lọc và đưa kết quả thẳng đến nơi ta cần luôn)

Anh ơi, Em thắc mắc, chỗ khai báo biến.
Dim Arr() As String, sArray, li As Long, lj As Long
- sArray hiện tại có phải nó đang được ngầm định, kiểu dữ liệu là Variant không? Nếu Em đổi lai khai báo sArray() [ có được hiểu là mảng động không]
- Sau khi Em khai báo sArray thì các dữ liệu của range(A1:A808945) vẫn được đưa vào bình thường.
Mong anh giải thích thêm.

phuyen89 · 21/5/17

ptm0412 đã viết:
Cách Dim như trên, sArray có thể là bất kỳ giá trị nào, đồng thời có thể là biến đơn hoặc biến mảng. Tuy nhiên, ngay sau khi gán giá trị 1 range vào, nó trở thành biến mảng. Khai báo trước là mảng cũng không sao.
Còn Dim Arr() tức là đã khai báo trước cho nó là mảng rồi. Mục đích khai báo trước nó là mảng, là để có thể ReDim. Biến chưa biết là mảng hay đơn thì không thể ReDim được.

Anh ơi.
Sao em cố tính tạo một biến được lưu dưới dạn Variant, nhưng em vẫn Redim được biến ấy.

PHP:

Sub Abc()
    Dim Arr
    Dim sArr()
    ReDim Arr(1 To 10, 1 To 1)
    ReDim sArr(1 To 10, 1 To 1)
End Sub

ndu96081631 · 22/5/17

phuyen89 đã viết:
Anh ơi, Em thắc mắc, chỗ khai báo biến.
Dim Arr() As String, sArray, li As Long, lj As Long
- sArray hiện tại có phải nó đang được ngầm định, kiểu dữ liệu là Variant không? Nếu Em đổi lai khai báo sArray() [ có được hiểu là mảng động không]
- Sau khi Em khai báo sArray thì các dữ liệu của range(A1:A808945) vẫn được đưa vào bình thường.
Mong anh giải thích thêm.

Khai báo vậy thì sArray là biến Variant, nó có thể là bất cứ thứ gì nên đương nhiên nó cũng có thể là mảng được và khi bạn "nạp" Range("A1:A808945") vào, nó sẽ trở thành mảng (tức là tùy bạn nạp thứ gì vào thì nó sẽ trở thành thứ ấy)
Nếu khai báo sArray() thì nó chỉ là biến mảng với số lượng phần tử chưa biết trước... và đương nhiên nó không thể trở thành "thứ khác" được (chỉ có thể là mảng thôi). Lấy ví dụ:
- Từ A1 đến A10 đang có dữ liệu nào đó
- Giờ ta khai báo Dim arr() đồng thời nạp giá trị A1:A10 vào nó

Mã:

Dim arr()
arr = Range("A1:A10").Value

- Mọi thứ chạy bình thường không lỗi
- Nhưng nếu bạn sửa lại:

Mã:

Dim arr()
arr = Range("A1").Value

Thì lỗi ngay lập tức. Bởi 1 cell duy nhất A1 thì không thể là mảng được. Trong khi nếu khai báo Dim arr (không có cặp dấu ngoặc) thì cả 2 code đều không lỗi

nvt22vn · 22/5/17

Thanks các bác nhé... may mà có bài này em mới làm được VBA của em

phuyen89 · 22/5/17

ndu96081631 đã viết:
Khai báo vậy thì sArray là biến Variant, nó có thể là bất cứ thứ gì nên đương nhiên nó cũng có thể là mảng được và khi bạn "nạp" Range("A1:A808945") vào, nó sẽ trở thành mảng (tức là tùy bạn nạp thứ gì vào thì nó sẽ trở thành thứ ấy)
Nếu khai báo sArray() thì nó chỉ là biến mảng với số lượng phần tử chưa biết trước... và đương nhiên nó không thể trở thành "thứ khác" được (chỉ có thể là mảng thôi). Lấy ví dụ:
- Từ A1 đến A10 đang có dữ liệu nào đó
- Giờ ta khai báo Dim arr() đồng thời nạp giá trị A1:A10 vào nó

Mã:

Dim arr() arr = Range("A1:A10").Value

- Mọi thứ chạy bình thường không lỗi
- Nhưng nếu bạn sửa lại:

Mã:

Dim arr() arr = Range("A1").Value

Thì lỗi ngay lập tức. Bởi 1 cell duy nhất A1 thì không thể là mảng được. Trong khi nếu khai báo Dim arr (không có cặp dấu ngoặc) thì cả 2 code đều không lỗi

Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr()
    Dim ArrayName()
    Dim sTen As String
    sTen = "Nguyen Ngoc Chung"
    ArrayName = Split(sTen, " ")
End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

befaint · 22/5/17

phuyen89 đã viết:
Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr() Dim ArrayName() Dim sTen As String sTen = "Nguyen Ngoc Chung" ArrayName = Split(sTen, " ") End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

Thử như vầy xem:

PHP:

Sub Arr()
    Dim ArrayName()
    Dim sTen As String
    sTen = "Nguyen Ngoc Chung"
'    ArrayName = Split(sTen, " ")
    MsgBox TypeName(Split(sTen, " "))
End Sub

ndu96081631 · 22/5/17

phuyen89 đã viết:
Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr() Dim ArrayName() Dim sTen As String sTen = "Nguyen Ngoc Chung" ArrayName = Split(sTen, " ") End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

- Khi bạn khai báo Dim ArrayName() thì có nghĩa biến ArrayName chính là 1 array mà các phần tử bên trong (nếu sau này nạp vào) được khai báo dạng Variant
- Trong khi đó hàm Split luôn luôn trả về kết quả là 1 mảng nhưng các phần tử bên trong nó chắc chắn là dạng String. Có thể thử nghiệm chúng minh:

Mã:

MsgBox TypeName(Split("A B C", " "))

Nhận kết quả là String()
Trong khi:

Mã:

MsgBox TypeName(ArrayName)

Ta sẽ nhận kết quả là Variant()
Ví dụ tiếp

Mã:

Sub Arr()
  Dim ArrayName()
  ArrayName = Array("A", "B", "C")
End Sub

Code này không lỗi bởi

Mã:

 MsgBox TypeName(Array("A", "B", "C"))

Sẽ cho kết quả cũng là Variant() tương đồng với kiểu biến của ArrayName
===> Từ đó suy ra: Cho trước 1 mảng có kiểu dữ liệu là A thì bạn chỉ có thể nạp thứ gì đó có kiểu dữ liệu A vào nó mà thôi
Vì lẽ đó mà khi bạn khai báo Dim ArrayName() as String sẽ không lỗi, bởi nó có cùng kiểu dữ liệu với kết quả của hàm Split
Và điều đương nhiên khai báo Dim ArrayName as Variant càng được, bởi khi đó ArrayName có kiểu dữ liệu "rộng" hơn, nó sẽ là bất cứ thứ gì tùy ý (như tôi đã dề cập ở bài trên)

phuyen89 · 23/5/17

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

HieuCD · 23/5/17

phuyen89 đã viết:

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

2 vòng lập lồng với nhau làm khối lượng duyệt qua các dòng rất lớn, bạn tìm hiểu phương thức Find chỉ dùng 1 vòng lập, hoặc Dictionary dùng 2 vòng lập tách rời ra sẽ nhanh hơn nhiều

phuyen89 · 23/5/17

HieuCD đã viết:
2 vòng lập lồng với nhau làm khối lượng duyệt qua các dòng rất lớn, bạn tìm hiểu phương thức Find chỉ dùng 1 vòng lập, hoặc Dictionary dùng 2 vòng lập tách rời ra sẽ nhanh hơn nhiều

PHP:

Sub LookupFunction()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long, rRang As Range
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    Set rRang = Sheets("Data").Range("A5:A5000")

    For i = 1 To k
        If Not rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext) Is Nothing Then
            Cells(i, 3).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 1).Value
            Cells(i, 4).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 2).Value
            Cells(i, 5).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 3).Value
            Cells(i, 6).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 4).Value
            Cells(i, 7).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 5).Value
            Cells(i, 8).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 6).Value
        End If
    Next i
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Anh ơi. Em viết dưới dạng mảng chưa được, Em chưa giải quyết được cấu trúc cú pháp của Find function từ Range sang Array.

PHP:

expression .Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

expression A variable that represents a Range object.

Khi áp dụng vào Array, em thay expression từ range thành biến của Array tương ứng vào range, nhưng vẫn chưa được. Anh gợi ý giúp đỡ.

HieuCD · 23/5/17

find chỉ dùng cho range

Mã:

Option Explicit

Sub VLK()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B1:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  For i = 1 To UBound(sArr1)
    Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    If Not C Is Nothing Then
      firstAddress = C.Address
      Do
        k = C.Row
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j)
        Next j
        Set C = Rng.FindNext(C)
      Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

HieuCD · 23/5/17

phuyen89 đã viết:

PHP:

Sub LookupFunction()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long, rRang As Range
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    Set rRang = Sheets("Data").Range("A5:A5000")

    For i = 1 To k
        If Not rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext) Is Nothing Then
            Cells(i, 3).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 1).Value
            Cells(i, 4).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 2).Value
            Cells(i, 5).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 3).Value
            Cells(i, 6).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 4).Value
            Cells(i, 7).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 5).Value
            Cells(i, 8).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 6).Value
        End If
    Next i
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Anh ơi. Em viết dưới dạng mảng chưa được, Em chưa giải quyết được cấu trúc cú pháp của Find function từ Range sang Array.

PHP:

expression .Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

expression A variable that represents a Range object.

Khi áp dụng vào Array, em thay expression từ range thành biến của Array tương ứng vào range, nhưng vẫn chưa được. Anh gợi ý giúp đỡ.

bài nầy dùng Dic nhanh hơn nhiều

Mã:

Option Explicit

Sub VLK1()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Tmp
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    sArr2 = .Range("A5:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sArr2)
      .Item(sArr2(i, 1)) = i
    Next i
    For i = 1 To UBound(sArr1)
      Tmp = sArr1(i, 1)
      If .exists(Tmp) Then
        k = .Item(Tmp)
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j + 1)
        Next j
      End If
    Next i
  End With
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

duynguyenhungthinhgia · 26/5/17

Hi mọi người. em là thành viên mới. em có đoạn code mà bị lỗi chỗ: Sheets(Array("A1:B9")).Copy. có bác nào cao thủ chỉ giúp em với
Sub myDim()
Application.ScreenUpdating = False
Dim a(7) As String
With ThisWorkbook
maxrow = .Sheets(1).UsedRange.Rows.Count
For t = 2 To maxrow
For i = 1 To 8
a(i - 1) = Sheets(1).Cells(t, i).Value
Next
If a(0) = "" Then
Exit For
Else
.Sheets(2).Activate
.Sheets(2).Range("B1").Value = a(2)
.Sheets(2).Range("B2").Value = a(3)
.Sheets(2).Range("B3").Value = a(4)
.Sheets(2).Range("B4").Value = a(1)
.Sheets(2).Range("B5").Value = a(0)
.Sheets(2).Range("B6").Value = a(5)
.Sheets(2).Range("B8").Value = a(7)
.Sheets(2).Range("B9").Value = a(6)
Sheets(Array("A1:B9")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & a(7) & a(1) & Format(Date, "yyyy"".""m"".""d"""";@") & ".xls"
ActiveWorkbook.Close
End If
Next
End With
Sheets(1).Activate
Application.ScreenUpdating = True
MsgBox "Íê³É"
End Sub

Ba Tê · 26/5/17

duynguyenhungthinhgia đã viết:
Hi mọi người. em là thành viên mới. em có đoạn code mà bị lỗi chỗ: Sheets(Array("A1:B9")).Copy. có bác nào cao thủ chỉ giúp em với
Sub myDim()
Application.ScreenUpdating = False
Dim a(7) As String
With ThisWorkbook
maxrow = .Sheets(1).UsedRange.Rows.Count
For t = 2 To maxrow
For i = 1 To 8
a(i - 1) = Sheets(1).Cells(t, i).Value
Next
If a(0) = "" Then
Exit For
Else
.Sheets(2).Activate
.Sheets(2).Range("B1").Value = a(2)
.Sheets(2).Range("B2").Value = a(3)
.Sheets(2).Range("B3").Value = a(4)
.Sheets(2).Range("B4").Value = a(1)
.Sheets(2).Range("B5").Value = a(0)
.Sheets(2).Range("B6").Value = a(5)
.Sheets(2).Range("B8").Value = a(7)
.Sheets(2).Range("B9").Value = a(6)
Sheets(Array("A1:B9")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & a(7) & a(1) & Format(Date, "yyyy"".""m"".""d"""";@") & ".xls"
ActiveWorkbook.Close
End If
Next
End With
Sheets(1).Activate
Application.ScreenUpdating = True
MsgBox "Íê³É"
End Sub

Nếu bạn muốn copy vùng A1 B9 của sheet(2) thì thế này

Mã:

.Sheets(2).Range("A1:B9").Copy

tueyennhi · 30/5/17

Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

HieuCD · 30/5/17

tueyennhi đã viết:
Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

bạn làm vấn đề nầy trong những bài tính lương khủng trước đây rồi mà, tạo 2 darr riêng

phuyen89 · 30/5/17

tueyennhi đã viết:
Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

- Chơi như thế này được không?
range("A1")=darr(k,1)

gán từng dòng trên mảng dArr xuống từng cột trên bảng tính Excel./

VetMini · 30/5/17

tueyennhi đã viết:
Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

1. Copy C sang một mảng khác. Sau khi copy mảng chính thì copy trở lại.
2. Copy dArr xuống 2 cột A và B. Copy dArr(i, 4) sang dArr(i, 1). Copy xuóng cột D

NguyenNgocThuHien · 30/5/17

HieuCD đã viết:

find chỉ dùng cho range

Mã:

Option Explicit

Sub VLK()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B1:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  For i = 1 To UBound(sArr1)
    Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    If Not C Is Nothing Then
      firstAddress = C.Address
      Do
        k = C.Row
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j)
        Next j
        Set C = Rng.FindNext(C)
      Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Kỳ vậy anh, code gốc chạy trong 0.8s, còn code này chay trong 15s. đã test nhiều lần.

tueyennhi · 30/5/17

Mình có tách như thế này nhưng công nó nhảy không đúng vào ngày, không biết sai ở đâu. Mình cũng chỉ cop nhặt và nhờ sự giúp đỡ của anh em trên này thôi nên có những thứ cơ bản có thể mình vẫn mắc lỗi. Code nằm trong Module Update_cong

tArr(Rws, C) = sArr(i, V1) cái này căn cứ theo C nhưng mà hiện tại nó bị đẩy tiến lên một cột mà mình không biết tại sao.

tueyennhi · 30/5/17

hpkhuong đã viết:
Là sao ? Là sao???

Có nghĩa là cái cột C của bạn có "bí kíp" gì đó hả??? Dán kết quả không muốn đè lên bí kíp này hay sao?

Nếu như tôi hỏi ở trên thì bắt bạn phải đưa cái cột C này vào mảng dArr trong khi code...

Mình nghĩ có khi nào tách ra làm hai mảng giống như HieuCD cũng đã nói ở trên được không. Hiện tại mình tách thì mảng tArr gán không như ý mình mong muốn. Gán từ Range("J8") thì nhảy chuẩn nhưng mình thắc mắc tại sao như vậy nhỉ? Và nếu bắt buộc phải gán như thế thì J8 coi như phải bỏ trống không dùng được ngoài việc để cho việc gán nó chuẩn. Vậy mảng nào gán vào cột bắt nguồn từ J8 này ??

NguyenNgocThuHien · 30/5/17

phuyen89 đã viết:

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

Mã:

Sub VLK2()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B5:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
 
 
  Dim lIndex As Long
 
  On Error GoTo loitimkiem
 
  For i = 1 To UBound(sArr1)
    'Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    
  
    lIndex = Application.WorksheetFunction.Match(sArr1(i, 1), Rng, 0)
    
      If lIndex <> 0 Then
            For j = 1 To 6
              dArr(i, j) = sArr2(lIndex, j)
            Next j
        End If
        

    
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
 
 
 
  Exit Sub
loitimkiem:
    lIndex = 0
    Resume Next
 
End Sub

ndu96081631 · 30/5/17

hpkhuong đã viết:
Nếu như tôi hỏi ở trên thì bắt bạn phải đưa cái cột C này vào mảng dArr trong khi code...

Nếu cột C có công thức thì lại... phiền
Ủng hộ cách dùng 2 mảng riêng, không đụng chạm gì nhau sẽ không.. mích lòng

phuyen89 · 30/5/17

NguyenNgocThuHien đã viết:
Kỳ vậy anh, code gốc chạy trong 0.8s, còn code này chay trong 15s. đã test nhiều lần.

Không biết về đường dài, find có nhanh hơn hay không. Nhưng với dữ liệu hiện tại, thì mảng nhanh hơn đó.

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

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

Thành viên gắn bó

Be all you can be !

File đính kèm

Hướng tới tương lai

Be all you can be !

Be all you can be !

Be all you can be !

Thành viên mới

Cạo Rồi Khỏi Gội

Be all you can be !

Thành viên gạo cội

File đính kèm

hello

Thành viên gạo cội

Thành viên mới

Chuyên gia GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Đang đi tìm hòn đá

I don't program, I beat code into submission!!!

Đang đi tìm hòn đá

I don't program, I beat code into submission!!!

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên chính thức

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên chính thức

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

File đính kèm

/(hông là gì!

File đính kèm

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên mới

hello

Thành viên mới

Thành viên mới

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Thành viên đã dừng hoạt động

Đang đi tìm hòn đá

Thành viên đã dừng hoạt động

Đang đi tìm hòn đá

Thành viên đã dừng hoạt động

Đang đi tìm hòn đá

Đang đi tìm hòn đá

Huyền thoại GPE

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

BĂNG TRÔI

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

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

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

BĂNG TRÔI

Đang đi tìm hòn đá

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

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

Chuyên gia GPE

Đang đi tìm hòn đá