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ị

hoamattroicoi · 9/2/12

nhờ MOD xóa bài này, bị trùng , mạng 3G của tôi bị nghẽn, hic

hoamattroicoi · 9/2/12

trungvdb đã viết:
Rắc rối quá nhỉ, thế để cho tổng quát ban đầu sao mình không cho nó lớn hết cỡ đi ví dụ
ReDim KQ(1 to 65536, 1 to 1) chẳng hạn, lúc đó sẽ chẳng cần quan tâm đến cái anh Arr làm chi.

Đã mất công xây dựng câu lệnh này :
Arr = Range([A1], [A65000].End(xlUp)).Value
Thì sao lại bắt cái KQ() chứa nhiều thế (mà chẳng để làm gì) dù mảng có vô địch về tốc độ thì cũng khổ thân cái máy tính bạn ạ.

ptm0412 · 9/2/12

nmhung49 đã viết:
Làm vậy cũng được mà nó sẽ tốn bộ nhớ máy tính bạn ah khi làm việc sẽ chậm hơn

Không chỉ tốn bộ nhớ không đâu, mà còn xảy ra chuyện 65 ngàn dòng vẫn thiếu đấy. Thí dụ lọc danh sách từ 2 hoặc nhiều cột thành một, mỗi cột 40 ngàn dòng là toi.

Cho nên vấn đề của ReDim là ở chỗ tính toán con số tương đối chính xác, dư 1 chút còn hơn thiếu, nhưng không phải quá dư để tốn bộ nhớ.

trungvdb · 9/2/12

Tôi đang từng bước tự làm các bài tập về mảng, tôi đang định tính tổng các thành phần cột B theo số thứ tự cột A nhưng chạy Code lại không được, xin hãy chỉ giúp tôi sửa lại cho đúng

PHP:

Sub btoan() Dim DL(), i As Long, Tmp 
DL = Range([B1], [B65000].End(xlUp)).Value 
ReDim Arr(1 To UBound(DL, 1), 1 To 2) 
For i = UBound(DL, 1) To 1 Step -1 
If Arr(i, 1) = "" Then 
Tmp = Arr(i, 2) + Tmp
 Else: Arr(i, 2).Value = Tmp 
Tmp = 0 
End If 
Next i
Range("B1").Resize(UBound(DL, 1), 1).Value = Arr 
End Sub

Trong file đính kèm tính tổng điền vào cột B (trong trường hợp này là ô B1 và ô B6)

Hoàng Trọng Nghĩa · 9/2/12

trungvdb đã viết:
Tôi đang từng bước tự làm các bài tập về mảng, tôi đang định tính tổng các thành phần cột B theo số thứ tự cột A nhưng chạy Code lại không được, xin hãy chỉ giúp tôi sửa lại cho đúng

PHP:

Sub btoan() Dim DL(), i As Long, Tmp DL = Range([B1], [B65000].End(xlUp)).Value ReDim Arr(1 To UBound(DL, 1), 1 To 2) For i = UBound(DL, 1) To 1 Step -1 If Arr(i, 1) = "" Then Tmp = Arr(i, 2) + Tmp Else: Arr(i, 2).Value = Tmp Tmp = 0 End If Next i Range("B1").Resize(UBound(DL, 1), 1).Value = Arr End Sub

Bạn đưa cái File mẫu lên xem, tôi nhìn chẳng hiểu tẹo nào cả? "tính tổng các thành phần cột B theo số thứ tự cột A" là tính làm sao?

ptm0412 · 9/2/12

- If Arr(i, 1) = "" Then
Arr vừa mới ReDim chứ chưa hề gán dữ liệu, thì i = bao nhiêu cũng trống rỗng

- Tmp = Arr(i, 2) + Tmp
Tmp chưa gán giá trị, nên cũng trống rỗng
Hai cái trống rỗng cộng nhau, may sao, bằng 0

- Else: Arr(i, 2).Value = Tmp
Dù cái Else này không bao giờ dùng tới, nhưng nếu dùng, Arr(i, 2) lại cũng bằng trống rỗng

- Tmp = 0
bây giờ thì có thể Tmp sẽ được gán giá trị 0, nếu như ...

Tóm lại, bước đầu phải là suy luận, bạn ạ. Bạn lấy dữ liệu từ cột B vào DL, còn Arr chả có gì hết, mà bạn toàn lấy từ Arr bỏ vào Arr, không hề đụng đến DL, thì làm sao mà ra kết quả?

hoamattroicoi · 9/2/12

Thấy lạ ở dòng này nữa :
DL = Range([B1], [B65000].End(xlUp)).Value
ReDim Arr(1 To UBound(DL, 1), 1 To 2)
Cái chỗ bôi đỏ đó không biết để làm gì, đang xét mảng gồm 1 cột và nhiều dòng mà, thêm cái đó máy tính khổ!
Câu lệnh này ;
Range("B1").Resize(UBound(DL, 1), 1).Value = Arr

Xử lý xong ÚP luôn kết quả lên vùng dữ liệu đang xét à, nhỡ code sai thì sao mà kiểm tra kết quả có đúng không nhỉ???

trungvdb · 9/2/12

Xin thày gợi ý chút nữa, tôi đã cố gắng sửa gần đúng rồi nhưng bản thân không phát hiện ra chỗ sai là ở đâu.

PHP:

Sub btoan()
Dim DL(), Dongcuoi As Long, Tmp
Dongcuoi = [B65000].End(xlUp)
DL = Range("A1:B" & Dongcuoi).Value
For i = UBound(DL, 1) To 1 Step -1
If DL(i, 1) > 0 Then
DL(i, 2) = Tmp
Tmp = 0
 Else
 Tmp = DL(i, 2) + Tmp
End If
Next i
Range("A1").Resize(UBound(DL, 1), 2).Value = DL
End Sub

hoamattroicoi · 9/2/12

trungvdb đã viết:
Xin thày gợi ý chút nữa, tôi đã cố gắng sửa gần đúng rồi nhưng bản thân không phát hiện ra chỗ sai là ở đâu.

PHP:

Sub btoan() Dim DL(), Dongcuoi As Long, Tmp Dongcuoi = [B65000].End(xlUp) DL = Range("A1:B" & Dongcuoi).Value For i = UBound(DL, 1) To 1 Step -1 If DL(i, 1) > 0 Then DL(i, 2) = Tmp Tmp = 0 Else Tmp = DL(i, 2) + Tmp End If Next i Range("A1").Resize(UBound(DL, 1), 2).Value = DL End Sub

Riêng câu lệnh này thôi :
Range("A1").Resize(UBound(DL, 1), 2).Value = DL
thì toàn bộ các câu lệnh ở trên bạn làm chẳng còn ý nghĩa gì nữa.
Bạn xử lý DL rồi gán vào Tmp xong đổ kết quả ra sheet lại đúng là DL thì còn chuyện gì để nói, he he!
Thế cái Tmp bạn khai báo ra để làm gì?

trungvdb · 9/2/12

Tôi cứ nghĩ thuật toán trên nếu tại cột A có số thứ tự thì cột B mới tính lại ( DL(i, 2) = Tmp), còn nếu không các ô khác cột B để nguyên.

Sau khi thực hiện xong lệnh For...Next thì Dl là mảng trong đó giá trị cột A như cũ, cột B ở những dòng cột A trống là như cũ, chỉ có những dòng A có số thứ tự thì giá trị B mới tính lại (tính tổng) chứ. Sau đó gán trở lại là đúng rồi chứ nhỉ?

Tmp khai báo có tính chất nó đi cộng dồn những giá trị những ô B dưới B rồi ném vào ô B (tương ứng cột A đánh số thứ tự).

Nếu có thể rất mong được mọi người sửa lại dùm Code để tôi có thể nhận ra cái sai của mình

trungvdb · 9/2/12

Tôi phát hiện ra chỗ sai rồi bác hoamattroicoi ah, hóa ra không phải sai ở thuật toán mà là sai ở dòng Dongcuoi = [B65000].End(xlUp),đúng ra nó phải là Dongcuoi = [B65000].End(xlUp).Row

PHP:

Sub TinhTong()
Dim Dongcuoi, i As Long, tmp As Double
Dim DL()
  Dongcuoi = [B65000].End(xlUp).Row
    DL = Range("A1:B" & Dongcuoi).Value
For i = UBound(DL) To 1 Step -1
  If DL(i, 1) > 0 Then
    DL(i, 2) = tmp
    tmp = 0
  Else
    tmp = tmp + DL(i, 2)
  End If
Next i
[A1].Resize(UBound(DL), 2) = DL
End Sub

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

Híc nhưng tôi cũng chưa hiểu tại sao 2 dòng này

PHP:

Dongcuoi = [B65000].End(xlUp)
Dongcuoi = [B65000].End(xlUp).Row

chúng khác nhau như thế nào? Bởi lẽ tôi Test thử 2 đoạn Code này:

PHP:

Sub TinhTong()
Dim Dongcuoi, i As Long
  Dongcuoi = [B65000].End(xlUp).Row
     i = Dongcuoi
   MsgBox i
End Sub

cho kết quả 19 cả giống hệt kết quả của đoạn

PHP:

Sub TinhTong()
Dim Dongcuoi, i As Long
  Dongcuoi = [B65000].End(xlUp)
     i = Dongcuoi
   MsgBox i
End Sub

ptm0412 · 9/2/12

Dongcuoi = [B65000].End(xlUp)

Câu này có nghĩa là Dongcuoi = giá trị ô cuối cột B. Đúng ra là:

Dongcuoi = [B65000].End(xlUp).Row

Sau đó chạy thử, và so sánh kết quả và suy luận của mình, tự tìm ra điểm sai. Nếu vẫn không thấy, hỏi tiếp.

ptm0412 · 9/2/12

trungvdb đã viết:
Tôi phát hiện ra chỗ sai rồi bác hoamattroicoi ah, hóa ra không phải sai ở thuật toán mà là sai ở dòng Dongcuoi = [B65000].End(xlUp),đúng ra nó phải là Dongcuoi = [B65000].End(xlUp).Row

Test thử 2 đoạn Code này:

PHP:

Sub TinhTong() Dim Dongcuoi, i As Long Dongcuoi = [B65000].End(xlUp).Row i = Dongcuoi MsgBox i End Sub

cho kết quả 19 cả giống hệt kết quả của đoạn

PHP:

Sub TinhTong() Dim Dongcuoi, i As Long Dongcuoi = [B65000].End(xlUp) i = Dongcuoi MsgBox i End Sub

Đó bởi vì bạn điền giá trị cho cột B bằng 1, 2, 3, ... đến hết (19). Dòng 19 có giá trị 19. Giống nhau là phải.

trungvdb · 9/2/12

Hóa ra do số tôi đánh vào trùng hợp (ô B19 đánh luôn 19) làm ngộ nhận kết quả giống nhau.
Tức là 1 cái là bằng giá trị ô B19 (Dongcuoi = [B65000].End(xlUp)) , cái kia trả về số dòng của ô B19 (Dongcuoi = [B65000].End(xlUp).Row)

Vì mới tập làm, nên phải vừa viết vừa hình dung cách dùng của từng đối tượng trong VBA, cũng may có thày chỉ bảo nên mới vỡ lẽ ra được nhiều vấn đề.

Rất mong được thày giúp đỡ, chỉ bảo thêm

Đa tạ thày rất nhiều

---------------------
Tôi cứ thắc mắc bác hoamattroicoi bảo thuật toán của tôi chưa hợp lý, vậy có cách làm làm tối ưu không hả thày

trungvdb · 9/2/12

Nếu bài toán tính tổng cho nhiều cột thì thuật toán làm như thế nào?

Tôi thắc mắc giả sử cột tổng cần tính được mở rộng ra khoảng 15 cột (từ cột B đến cột P) chẳng hạn thì thuật toán phải là thế nào?

(Lẽ dĩ nhiên khi đã tính ra được cột B rồi thì chỉ việc Copy sang các cột khác thôi, tuy nhiên nếu dữ liệu lớn thì sẽ mất thời gian, chắc đưa vào Code tính luôn sẽ nhanh hơn)

------------
Nhưng nếu cách giải vẫn như bài cũ thì sẽ rất dài (nhiều dòng lệnh), phải đặt những 15 biến kiểu như Tmp? Xin hỏi cách nào thuật toán gọn nhất.

Ba Tê · 9/2/12

trungvdb đã viết:
Tôi thắc mắc giả sử cột tổng cần tính được mở rộng ra khoảng 15 cột (từ cột B đến cột P) chẳng hạn thì thuật toán phải là thế nào?

(Lẽ dĩ nhiên khi đã tính ra được cột B rồi thì chỉ việc Copy sang các cột khác thôi, tuy nhiên nếu dữ liệu lớn thì sẽ mất thời gian, chắc đưa vào Code tính luôn sẽ nhanh hơn)

------------
Nhưng nếu cách giải vẫn như bài cũ thì sẽ rất dài (nhiều dòng lệnh), phải đặt những 15 biến kiểu như Tmp? Xin hỏi cách nào thuật toán gọn nhất.

Thử code này xem, mình cũng mới tập tành với cái mảng trong VBA

PHP:

Public Sub GPE()
Dim Arr(), Tong(), i As Long, y As Long
Arr = Range([B3], [P100].End(xlUp)).Value
ReDim Tong(1 To UBound(Arr, 1) + 1, 1 To UBound(Arr, 2))
For i = UBound(Arr, 1) To 1 Step -1
    For y = 1 To UBound(Arr, 2)
        If Arr(i, y) <> "" Then
            Tong(i, y) = Tong(i + 1, y) + Arr(i, y)
        Else
            Arr(i, y) = Tong(i + 1, y)
            Tong(i, y) = 0
        End If
    Next y
Next i
 Range([B3], [P100].End(xlUp)).Value = Arr
End Sub

trungvdb · 10/2/12

Sau khi tính toán ra được các công việc thứ tự các công việc là 1,2,3..., tôi muốn tổng hợp thêm theo nhóm nữa: Nhóm I (bao gồm các thành phần con là 1,2,3), nhưng ngồi từ sáng đến giờ không phát hiện ra Code sai ở đâu, xin nhờ mọi người giúp

PHP:

Sub tinhtong()
Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong
Dongcuoi = [B65000].End(xlUp).Row
DL = Range("A8:B" & Dongcuoi).Value
For i = UBound(DL, 1) To 1 Step -1
If DL(i, 1) = "" Then
Tmp = Tmp + DL(i, 2)
ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then
DL(i, 2) = Tmp
Congviec = i
Tong = Tong + DL(Congviec, 1)
Tmp = 0
Else
DL(i, 2) = Tong
Tong = 0
End If
Next i
Range("A8:B" & Dongcuoi).Value = DL
End Sub

viehoai · 10/2/12

trungvdb đã viết:
Sau khi tính toán ra được các công việc thứ tự các công việc là 1,2,3..., tôi muốn tổng hợp thêm theo nhóm nữa: Nhóm I (bao gồm các thành phần con là 1,2,3), nhưng ngồi từ sáng đến giờ không phát hiện ra Code sai ở đâu, xin nhờ mọi người giúp

PHP:

Sub tinhtong() Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong Dongcuoi = [B65000].End(xlUp).Row DL = Range("A8:B" & Dongcuoi).Value For i = UBound(DL, 1) To 1 Step -1 If DL(i, 1) = "" Then Tmp = Tmp + DL(i, 2) ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then DL(i, 2) = Tmp Congviec = i Tong = Tong + DL(Congviec, 1) Tmp = 0 Else DL(i, 2) = Tong Tong = 0 End If Next i Range("A8:B" & Dongcuoi).Value = DL End Sub

Mình nói sơ bạn tự sửa nhé:
1. Khi i=1 thì Dl(i-1,1)=??? báo lỗi
2. Trường hợp của ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then thì DL(i-1, 2) = Tmp chứ không phải DL(i, 2) = Tmp
3. Sau Else để làm gì? bỏ nó thử xem
PS: Bạn chú ý B14=133 chứ không phải như trong file bạn để test lại kết quả
Thân

trungvdb · 10/2/12

viehoai đã viết:
Mình nói sơ bạn tự sửa nhé:
1. Khi i=1 thì Dl(i-1,1)=??? báo lỗi
2. Trường hợp của ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then thì DL(i-1, 2) = Tmp chứ không phải DL(i, 2) = Tmp
Thân

1. Cái 1 thì đúng là cần phải tìm cách khắc phục sửa lại theo ý bác rồi.
2. Nhưng dòng 2 ý tôi muốn thể hiện đối việc nhỏ (1,2,3 chứ không phải là nhóm việc lớn I, II) thì DL(i, 2) = Tmp chứ sao lại là DL(i-1, 2) = Tmp?

viehoai · 10/2/12

trungvdb đã viết:
1. Cái 1 thì đúng là cần phải tìm cách khắc phục sửa lại theo ý bác rồi.
2. Nhưng dòng 2 ý tôi muốn thể hiện đối việc nhỏ (1,2,3 chứ không phải là nhóm việc lớn I, II) thì DL(i, 2) = Tmp chứ sao lại là DL(i-1, 2) = Tmp?

Theo như file thì bạn muốn tính tổng các số 1, 2, 3.. hay là I, II,.. hay cả hai?
(Mình thấy trong file 1, 2, 3,.. đã có số liệu nên bạn chỉ cần tính tổng của I, II)
Bạn nói rõ hơn rồi mình bàn tiếp

trungvdb · 10/2/12

viehoai đã viết:
Theo như file thì bạn muốn tính tổng các số 1, 2, 3.. hay là I, II,.. hay cả hai?
(Mình thấy trong file 1, 2, 3,.. đã có số liệu nên bạn chỉ cần tính tổng của I, II)
Bạn nói rõ hơn rồi mình bàn tiếp

Cả 2 bác ah, ban đầu tính tổng củ 1,2,3...sau đó tính nhóm I, II...( trong file đính kèm I = 1 + 2 tức B8=B9+B14 ). Tức là tôi muốn tính tổng hợp theo 2 cấp.

viehoai · 10/2/12

trungvdb đã viết:
Cả 2 bác ah, ban đầu tính tổng củ 1,2,3...sau đó tính nhóm I, II...( trong file đính kèm I = 1 + 2 tức B8=B9+B14 ). Tức là tôi muốn tính tổng hợp theo 2 cấp.

Vậy mình sửa theo code của bạn thử nhé

PHP:

Sub tinhtong()
Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong
Dongcuoi = [B65000].End(xlUp).Row
DL = Range("A8:B" & Dongcuoi).Value
On Error Resume Next
For i = UBound(DL, 1) To 1 Step -1If DL(i, 1) = "" Then
Tmp = Tmp + DL(i, 2)
ElseIf DL(i, 1) <> "" And IsNumeric(DL(i, 1)) Then
DL(i, 2) = Tmp
'Congviec = i
Tong = Tong + DL(i, 2)Tmp = 0
Else DL(i, 2) = TongTong = 0
End If
Next i
Range("A8:B" & Dongcuoi).Value = DL
End Sub

trungvdb · 10/2/12

Làm như bác trong trường hợp dữ liệu bài trên là ổn, code

PHP:

Sub tinhtong()
Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong
Dongcuoi = [B65000].End(xlUp).Row
DL = Range("A8:B" & Dongcuoi).Value
On Error Resume Next
For i = UBound(DL, 1) To 1 Step -1
If DL(i, 1) = "" Then
Tmp = Tmp + DL(i, 2)
ElseIf DL(i, 1) <> "" And IsNumeric(DL(i, 1)) Then
DL(i, 2) = Tmp
Congviec = i
Tong = Tong + DL(i, 2)
Tmp = 0
Else: DL(i, 2) = Tong
Tong = 0
End If
Next i
Range("A8:B" & Dongcuoi).Value = DL
End Sub

Tuy nhiên, để khắc phục hiện tượng bị lỗi theo cách tôi làm (Khi i=1 thì Dl(i-1,1)=??? báo lỗi).

Bác đưa ra giải pháp là I và II nó không phải là số, nhưng nếu giả sử áp dụng vào bài toán khác nếu số thứ tự cần tính tổng ở 2 cấp độ cùng là số hoặc Text thì làm sao
(1,2 biến thành a, b thì sao).

Em ví dụ theo file đính kèm ở dưới

Không lẽ ta phải duyệt từ trên xuống dưới hả bác?

ndu96081631 · 10/2/12

trungvdb đã viết:
Tuy nhiên, để khắc phục hiện tượng bị lỗi theo cách tôi làm (Khi i=1 thì Dl(i-1,1)=??? báo lỗi).

Bác đưa ra giải pháp là I và II nó không phải là số, nhưng nếu giả sử áp dụng vào bài toán khác nếu số thứ tự cần tính tổng ở 2 cấp độ cùng là số hoặc Text thì làm sao
(1,2 biến thành a, b thì sao).

Em ví dụ theo file đính kèm ở dưới

Không lẽ ta phải duyệt từ trên xuống dưới hả bác?

Nói chung để code chạy thì bạn phải chỉ ra được sự khác nhau của 2 kiểu dữ liệu (ví dụ loại thứ nhất luôn là chữ I chẳng hạn) ---> Nếu không làm rõ được điều này và nay nhập vầy, mai lại nhập khác thì code nó biết đường đâu mà lần

trungvdb · 10/2/12

ndu96081631 đã viết:
Nói chung để code chạy thì bạn phải chỉ ra được sự khác nhau của 2 kiểu dữ liệu (ví dụ loại thứ nhất luôn là chữ I chẳng hạn) ---> Nếu không làm rõ được điều này và nay nhập vầy, mai lại nhập khác thì code nó biết đường đâu mà lần

Dấu hiệu để nhận diện chỉ ra được sự khác nhau của 2 kiểu dữ liệu trong tất cả các file thực tế công việc của tôi là: Các dòng tổng lớn (ứng với I, II trong bài này) luôn nằm trên các dòng tổng nhỏ tức ô ngay dưới nó không phải ô trắng khác với các dòng tổng nhỏ ô liền dưới nó là ô trắng (rỗng).

Trong Code:

PHP:

Sub tinhtong()
Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong
Dongcuoi = [B65000].End(xlUp).Row
DL = Range("A8:B" & Dongcuoi).Value
For i = UBound(DL, 1) To 1 Step -1
If DL(i, 1) = "" Then
Tmp = Tmp + DL(i, 2)
ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then
DL(i, 2) = Tmp
Congviec = i
Tong = Tong + DL(Congviec, 2)
Tmp = 0
Else
DL(i, 2) = Tong
Tong = 0
End If
Next i
Range("A8:B" & Dongcuoi).Value = DL
End Sub

Nó có nhược điểm là ô trên cùng DL(i - 1, 1) = DL(0,1) nên bị lỗi, tôi chưa nghĩ ra cách nào để sửa cả.
Xin thày Ndu và mọi người gợi ý cho giải pháp để khắc phục.

ndu96081631 · 10/2/12

trungvdb đã viết:
Dấu hiệu để nhận diện chỉ ra được sự khác nhau của 2 kiểu dữ liệu trong tất cả các file thực tế công việc của tôi là: Các dòng tổng lớn (ứng với I, II trong bài này) luôn nằm trên các dòng tổng nhỏ tức ô ngay dưới nó không phải ô trắng khác với các dòng tổng nhỏ ô liền dưới nó là ô trắng (rỗng).

.

Số I la mã thì khỏi cần bàn (nó nằm đầu tiên).
Vậy bạn nói cho mọi người biết làm cách nào để "nhận ra" được số II la mã
???
Sao bạn không tách chúng thành 2 cột cho dễ xử lý?

Hoàng Trọng Nghĩa · 10/2/12

trungvdb đã viết:
Dấu hiệu để nhận diện chỉ ra được sự khác nhau của 2 kiểu dữ liệu trong tất cả các file thực tế công việc của tôi là: Các dòng tổng lớn (ứng với I, II trong bài này) luôn nằm trên các dòng tổng nhỏ tức ô ngay dưới nó không phải ô trắng khác với các dòng tổng nhỏ ô liền dưới nó là ô trắng (rỗng).

Bạn đang học về mảng thì OK, tuy nhiên, vọc chưa đúng cách cũng không tốt. Bạn cần đưa ra một file giả lập thôi, một bên là dữ liệu đầu vào và một bên là đầu ra (kết quả mong đợi của bạn), như vậy sẽ dễ dàng có định hướng cho bài của bạn hơn.

trungvdb · 10/2/12

ndu96081631 đã viết:
Nói chung để code chạy thì bạn phải chỉ ra được sự khác nhau của 2 kiểu dữ liệu (ví dụ loại thứ nhất luôn là chữ I chẳng hạn) ---> Nếu không làm rõ được điều này và nay nhập vầy, mai lại nhập khác thì code nó biết đường đâu mà lần

II có đặc điểm là ô dưới nó có một số (cụ thể fle đính kèm là số 1), trong khi các dòng tổng nhỏ thì ô dưới nó là để trống.

(Vì đây là dữ liệu kế thừa của phòng nghiệp vụ khác, chương trình khác trong cơ quan sinh ra ah, chứ không phải do bản thân tự nhập).

Ba Tê · 10/2/12

trungvdb đã viết:
Dấu hiệu để nhận diện chỉ ra được sự khác nhau của 2 kiểu dữ liệu trong tất cả các file thực tế công việc của tôi là: Các dòng tổng lớn (ứng với I, II trong bài này) luôn nằm trên các dòng tổng nhỏ tức ô ngay dưới nó không phải ô trắng khác với các dòng tổng nhỏ ô liền dưới nó là ô trắng (rỗng).

Trong Code:

PHP:

Sub tinhtong() Dim DL(), i As Long, Dongcuoi, Tmp, Congviec, Tong Dongcuoi = [B65000].End(xlUp).Row DL = Range("A8:B" & Dongcuoi).Value For i = UBound(DL, 1) To 1 Step -1 If DL(i, 1) = "" Then Tmp = Tmp + DL(i, 2) ElseIf DL(i, 1) <> "" And DL(i - 1, 1) <> "" Then DL(i, 2) = Tmp Congviec = i Tong = Tong + DL(Congviec, 2) Tmp = 0 Else DL(i, 2) = Tong Tong = 0 End If Next i Range("A8:B" & Dongcuoi).Value = DL End Sub

Nó có nhược điểm là ô trên cùng DL(i - 1, 1) = DL(0,1) nên bị lỗi, tôi chưa nghĩ ra cách nào để sửa cả.
Xin thày Ndu và mọi người gợi ý cho giải pháp để khắc phục.

Tôi thấy quả là tự mình làm mình thêm rắc rối, nếu tiêu đề tổng nhỏ a,b,c nằm 1 cột, tiêu đề tổng lớn I,II,III... nằm trên cột khác thì làm quá dễ dàng.
Quét từ dưới lên, gặp dòng tổng nhỏ thì tính tổng nhỏ, gặp dòng tổng lớn thì tính tổng lớn, mắc chi cho nó chung một cột rồi sinh ra lắm thứ số, text...

ndu96081631 · 10/2/12

trungvdb đã viết:
II có đặc điểm là ô dưới nó có một số (cụ thể fle đính kèm là số 1), trong khi các dòng tổng nhỏ thì ô dưới nó là để trống.

(Vì đây là dữ liệu kế thừa của phòng nghiệp vụ khác, chương trình khác trong cơ quan sinh ra ah, chứ không phải do bản thân tự nhập).

Bạn đưa lại file lên đi...
Tôi kiểm tra trong file ở bài 224 thì thấy " ở dưới" thằng nào cũng có num cả

trungvdb · 10/2/12

Tôi xin gửi lại File lên, nhờ thày giúp cho (các ô cần tính bôi màu vàng)

Hoàng Trọng Nghĩa · 10/2/12

trungvdb đã viết:
Tôi xin gửi lại File lên, nhờ thày giúp cho (các ô cần tính bôi màu vàng)

Vậy sao bạn không đưa luôn kết quả tính như thế nào luôn để dễ làm hơn không?

ndu96081631 · 10/2/12

trungvdb đã viết:
Tôi xin gửi lại File lên, nhờ thày giúp cho (các ô cần tính bôi màu vàng)

Nếu vậy thì câu trả lời ở bài 223 của viethoai đúng kết quả rồi còn gì

trungvdb · 10/2/12

Nhưng cách của bác Viethoai trong trường hợp này thì dòng I và II không chạy được.

ndu96081631 · 10/2/12

trungvdb đã viết:
Nhưng cách của bác Viethoai trong trường hợp này thì dòng I và II không chạy được.

Như bạn đã nói: dấu hiệu nhận ra thằng tổng "bự" là dưới nó phải có "cái gì đó", đúng không?
Vậy thì sửa lại tí:

PHP:

Sub tinhtong()
  Dim DL(), i As Long, Tmp1, Tmp2
  DL = Range([A8], [B65000].End(xlUp)).Value
  On Error Resume Next
  For i = UBound(DL, 1) To 1 Step -1
    If DL(i, 1) = "" Then
      Tmp1 = Tmp1 + DL(i, 2)
    ElseIf DL(i, 1) <> "" Then
      DL(i, 2) = Tmp1
      Tmp2 = Tmp2 + Tmp1
      Tmp1 = 0
      If DL(i + 1, 1) <> "" Then
        DL(i, 2) = Tmp2
        Tmp2 = 0
      End If
    End If
  Next i
  Range([A8], [B65000].End(xlUp)).Value = DL
End Sub

trungvdb · 10/2/12

Cảm ơn thày Ndu rất nhiều, chiều nghĩ mãi tôi đã làm gần như thày mà mãi không ra, nhờ Code của thày giảng bây giờ tôi đã hiểu được nguyên nhân rồi

PHP:

Sub tinhtong()
  Dim DL(), i As Long, Tmp1, Tmp2
  DL = Range([A8], [B65000].End(xlUp)).Value
  On Error Resume Next
  For i = UBound(DL, 1) To 1 Step -1
    If DL(i, 1) = "" Then
      Tmp1 = Tmp1 + DL(i, 2)
    ElseIf DL(i, 1) <> "" Then
      DL(i, 2) = Tmp1
      Tmp2 = Tmp2 + Tmp1
      Tmp1 = 0
      ElseIf DL(i + 1, 1) <> "" Then
                 DL(i, 2) = Tmp2
        Tmp2 = 0
          End If
  Next i
  Range([A8], [B65000].End(xlUp)).Value = DL
End Sub

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

Hóa ra nó khác nhau (trước tôi cứ tưởng giống nhau), của thày If sau đè, thay thế If trước vì 2 thằng If này bình đẳng vai trò, đẳng cấp bằng nhau;

Cách làm trước của tôi dùng ElseIf nên teo, thằng sau "không dám thay" thằng trước do nó là cấp dưới nên sợ cấp trên.

Chúc thày luôn mạnh khỏe, hạnh phúc.

trungvdb · 10/2/12

Thời gian này rỗi tôi đang cố gắng nghiên cứu về Dictionary, hôm nọ tôi đã được các thày lọc giúp một bài mẫu, hôm nay ngồi nghiên cứu tôi thử làm
Bài toán: Lọc các giá trị duy nhất của cột A ra cột B

PHP:

Sub locDic()
  Dim KQ(), DL(), i As Long, Dic As Object
  Set Dic = CreateObject("Scripting.Dictionary")
  dongcuoi = [A65000].End(xlUp).Row
  DL = Range("A1:A" & dongcuoi).Value
 Range("B:B").Clear
  ReDim KQ(1 To UBound(DL, 1), 1 To 1)
  For i = 1 To UBound(DL)
        If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
          End If
  Next
  Range("B1").Resize(j) = KQ
End Sub

Nhưng tôi vẫn lăn tăn (j) ở đoạn Dic.Add DL(i, 1), j chẳng có nghĩa gì? Tức Item trong trường hợp này không cần thiết?

Không biết sư phụ Ptm0412 hôm nay đi đâu mà không thấy vào diễn đàn; hôm nào thày mắng, nhắc nhở nhiều thì mình phải cố gắng hơn nữa.

ndu96081631 · 10/2/12

trungvdb đã viết:
Xin làm phiền mọi người một chút, thời gian này rỗi tôi đang cố gắng nghiên cứu về Dictionary, hôm nọ tôi đã được các thày lọc giúp một bài mẫu, hôm nay ngồi nghiên cứu tôi thử làm thuật toán khác đi một chút xem có được không.

Bài toán: Lọc duy nhất những giá trị của cột A ra cột B

PHP:

Sub Loc() Dim DL(), i As Long, Dongcuoi As Long, Dic As Object Dongcuoi = [A65000].End(xlUp).Row DL = Range("A1:A" & Dongcuoi).Value ReDim KQ(1 To UBound(DL, 1), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(DL, 1) If DL(i, 1) <> "" And Not Dic.exists(DL(i, 1)) Then j = j + 1 Dic.Add DL(i, 1), j KQ(j, 1) = DL(i, 1) End If Next End With [B1].Resize(j, 1).Value = KQ End Sub

Xin chỉ dùm Code trên thiếu cái gì mà chạy chưa được.

Không biết sư phụ Ptm0412 hôm nay đi đâu mà không thấy vào diễn đàn; hôm nào thày mắng, nhắc nhở nhiều thì mình phải cố gắng hơn nữa.

Bạn đã khai báo Dic as Object nhưng chẳng có động tác Set nó bằng cái gì cả nên lỗi là phải rồi
Vậy bạn có 2 lựa chọn
1> Dùng biến Dic và Set nó thành Dictionary

PHP:

Sub Loc()
  Dim DL(), i As Long, Dic As Object, j As Long
  DL = Range([A1], [A65000].End(xlUp)).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 1)
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
      j = j + 1
      Dic.Add DL(i, 1), j
      KQ(j, 1) = DL(i, 1)
    End If
  Next
  [B1].Resize(j, 1).Value = KQ
End Sub

2> Dùng With... End With và khỏi cần biến Dic (Vì Dictionary ở trong With.. End With rồi)

PHP:

Sub Loc()
  Dim DL(), i As Long, j As Long
  DL = Range([A1], [A65000].End(xlUp)).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(DL, 1)
      If DL(i, 1) <> "" And Not .Exists(DL(i, 1)) Then
        j = j + 1
        .Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
      End If
    Next
  End With
  [B1].Resize(j, 1).Value = KQ
End Sub

Nói chung thuật toán là vậy nhưng khi áp dụng nên phòng những lỗi có thể xảy ra, chẳng hạn vùng cột A chẳng có dữ liệu nào nên j sẽ = 0 (không tạo được mảng KQ)
Ngoài ra, thay vì IF và AND, nên chia thành 2 IF... Tức loại trừ từ từ, như thế tốc độ sẽ nhanh hơn (thay vì luôn phải xét 2 đk cùng lúc)
Cuối cùng, dù rằng không còn nghĩ ra được còn lỗi gì có thể xảy ra cũng nên cho câu bẫy lỗi đầu code (phòng những sự cố ngoài ý muốn)
Tôi sẽ làm như sau:

PHP:

Sub Loc()
  Dim DL(), i As Long, j As Long, tmp As String
  On Error GoTo ExitSub ''<-- Bay loi phuong ngua
  DL = Range([A1], [A65000].End(xlUp)).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(DL, 1)
      If CStr(DL(i, 1)) <> "" Then ''<-- Dùng 2 lan IF theo phuong phap loai tru, toc do se nhanh hon
        tmp = CStr(DL(i, 1))
        If Not .Exists(tmp) Then
          j = j + 1
          .Add tmp, j
          KQ(j, 1) = tmp
        End If
      End If
    Next
  End With
  If j > 0 Then Range("B1").Resize(j, 1).Value = KQ ''<-- IF cho nay de kiem tra xem mang da duoc tao hay chua?
ExitSub:
End Sub

trungvdb · 10/2/12

Trước kia do chưa biết từ lập trình là gì, những bài đầu rất lúng túng (cả về thuật toán và cú pháp), nhờ những kiến thức quý báu của các thày chỉ dạy đến nay tôi cảm thấy đã bắt đầu dễ dàng hơn khi thực hành (nếu so sánh với chính bản thân tôi cách đây khoảng 1 tháng thì đúng là tốt lên rất nhiều), dĩ nhiên nhiều khi vẫn chưa đi đến kết quả cuối cùng nhưng những điểm sai đã phần nào ít hơn, đã dần hiểu hơn bản chất các đối tượng, hướng giải quyết bài toán đã rõ ràng hơn.

Quả thật không biết phải nói lời cảm ơn của mình thế nào đối với các thày, mọi người trên diễn đàn. Xin cảm tạ rất nhiều

-----------------------
Xin thắc mắc 1 chút: Trong bài toán này hình như thành phần Item trong cú pháp Dic.Add Key, Item không có nhiều ý nghĩa lắm thì phải, vì tôi thấy cái .Add tmp, j (thì j có vẻ hơi thừa?) bởi thay j bằng cái gì cũng được (vì đã có j = j+1 ở trên rồi)

ndu96081631 · 11/2/12

trungvdb đã viết:
Xin thắc mắc 1 chút: Trong bài toán này hình như thành phần Item trong cú pháp Dic.Add Key, Item không có nhiều ý nghĩa lắm thì phải, vì tôi thấy cái .Add tmp, j (thì j có vẻ hơi thừa?) bởi thay j bằng cái gì cũng được (vì đã có j = j+1 ở trên rồi)

Vì trong bài này bạn không dùng đến nên nó xem như là thừa nên có thể sửa thành Dic.Add tmp, "" (tức không xài Item)
Rất nhiều bài toán mà việc xài Item trở nên rất hiệu quả... Dùng nó để "đánh dấu vị trí" hoặc lọc duy nhất và cộng dồn chẳng hạn...
Nói chung, công cụ là thế, xài thế nào là việc của ta

trungvdb · 11/2/12

Dictionary lọc duy nhất có lấy được dòng cuối cùng (trong TH nhiều dòng bằng nhau)?

Tôi dùng Dictionary, dữ liệu đầu vào là cột A, B, dữ liệu đầu ra sau khi chạy Code được kết quả là cột D, E như hình dưới.

PHP:

Sub Loc()
Dim DL, KQ, i As Long, j As Long, dongcuoi
Set Dic = CreateObject("Scripting.Dictionary")
dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:B" & dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To 2)
For i = 1 To UBound(DL, 1)
If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
    End If
Next
If j > 0 Then [D1].Resize(j, 2).Value = KQ
End Sub

Theo mặc định nếu cột A có từ 2 giá trị giống nhau trở lên thì Dic sẽ đưa dòng đầu tiên vào Dic.Add key, Item. Ví dụ ứng với cột A, ngày 2-1-2012 có hai dòng 4,5 bằng nhau thì Dic sẽ lấy dòng 4 cho sang vùng kết quả.

Tuy vậy, do yêu cầu công việc tôi muốn key nạp vào Dic sẽ lấy ô cuối cùng trong số các ô bằng nhau (cụ thể ở bài toán này, ví dụ kết quả E3 trên hình theo yêu cầu đặt ra là 135 thay vì mặc định là 130) thì phải làm thế nào? Liệu Dictionary có giải quyết được TH này không, hay là phải chuyển sang làm kiểu khác.

ndu96081631 · 11/2/12

trungvdb đã viết:
Theo mặc định nếu cột A có từ 2 giá trị giống nhau trở lên thì Dic sẽ đưa dòng đầu tiên vào Dic.Add key, Item. Ví dụ ứng với cột A, ngày 2-1-2012 có hai dòng 4,5 bằng nhau thì Dic sẽ lấy dòng 4 cho sang vùng kết quả.

Tuy vậy, do yêu cầu công việc tôi muốn key nạp vào Dic sẽ lấy ô cuối cùng trong số các ô bằng nhau (cụ thể ở bài toán này, ví dụ kết quả E3 trên hình theo yêu cầu đặt ra là 135 thay vì mặc định là 130) trong số các ô bằng nhau thì phải làm thế nào? Liệu Dictionary có giải quyết được TH này không, hay là phải chuyển sang làm kiểu khác.

Đây là lúc mà bạn thấy Item phát huy tác dụng... Ta sẽ dùng Item để đánh dấu vị trí của mảng KQ thông qua giá trị j

PHP:

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
      Else
        KQ(Dic.Item(tmp), 2) = DL(i, 2)
      End If
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

ThuNghi · 11/2/12

ndu96081631 đã viết:

Đây là lúc mà bạn thấy Item phát huy tác dụng... Ta sẽ dùng Item để đánh dấu vị trí của mảng KQ thông qua giá trị j

PHP:

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add DL(i, 1), j
        KQ(j, 1) = DL(i, 1)
        KQ(j, 2) = DL(i, 2)
      Else
        KQ(Dic.Item(tmp), 2) = DL(i, 2)
      End If
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

Hình như hơi dư dòng

PHP:

KQ(j, 2) = DL(i, 2)
      Else

Sao kg add vào KQ như sau, đàng nào cũng phải add dòng cuối.

PHP:

Sub Loc2()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(Dic.Item(tmp), 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

ndu96081631 · 11/2/12

ThuNghi đã viết:

Hình như hơi dư dòng

PHP:

KQ(j, 2) = DL(i, 2)
      Else

Sao kg add vào KQ như sau, đàng nào cũng phải add dòng cuối.

PHP:

Sub Loc2()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(Dic.Item(tmp), 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

Bạn trungvdb đang thắc mắc về cách áp dụng Item ấy mà... nên cho 1 ví dụ thôi

trungvdb · 11/2/12

Tôi có thắc mắc: Trong quá trình nạp vào Dic, nó kiểm tra trường hợp giá trị đó đã có trong thư viện (keys) của Dic rồi thì nó có đâu có được nạp vào (tức là không được Dic đánh dấu dòng đó) thì làm sao mà sinh ra Item của dòng đó được nhỉ, như vậy làm gì có cơ sở để thực hiện dòng KQ(Dic.Item(tmp), 2) = DL(i, 2)?

ndu96081631 · 11/2/12

trungvdb đã viết:
Nhưng Dic nó kiểm tra trường hợp giá trị đó đã có trong thư viện (keys) của Dic rồi thì nó có đâu có được nạp vào (tức là không được Dic đánh dấu dòng đó) thì làm sao mà sinh ra Item của dòng đó được nhỉ?

Quá trình hoạt động như sau:
- Kiểm tra xem có tồn tại trong Dic hay không? Nếu không tồn tại, nạp 1 cặp gồm Key và Item (trong đó Item chính là biến j trong bài của bạn và nó cũng là vị trí dòng thứ j trong mảng KQ)
- Ngược lại (là Else ấy), tức có tồn tại rồi thì tra Key (là biến tmp) để lấy ra giá trị j ---> Từ đó thay đổi giá trị thứ j trong mảng KQ
Thế thôi
Nói thêm: Dic.Item(tmp) là tìm xem cái "thằng" Key tmp ấy đang chứa Item nào! Nó gần giống như hàm VLOOKUP với trị tìm là tmp, bảng tra là Dictionary, kết quả tìm nằm ở Items

trungvdb · 11/2/12

Cái này quả là tôi chưa biết. Tôi hiểu thế này không biết có đúng không:

Trong quá trình Dic đi dò cột A để thêm vào key của nó, nếu giá trị đó đã có rồi thì thực chất dòng đó vẫn có Item, chỉ có điều Item này không nạp vào Dic (Dic.Add tmp, j)

Có nghĩa là KQ(Dic.Item(tmp), 2) = DL(i, 2) bao hàm rộng hơn là KQ(j, 2) = DL(i, 2). Nó chỉ bằng nhau trong lần đầu tiên thôi

(nói cách khác là nếu trong trường hợp đã có rồi thì chỉ có khái niệm Dic.Item(tmp) mà không tồn tại j?)

ndu96081631 · 11/2/12

trungvdb đã viết:
Cái này quả là tôi chưa biết. Tôi hiểu thế này không biết có đúng không:

Trong quá trình Dic đi dò cột A để thêm vào key của nó, nếu giá trị đó đã có rồi thì thực chất dòng đó vẫn có Item, chỉ có điều Item này không nạp vào Dic (Dic.Add tmp, j)

Có nghĩa là KQ(Dic.Item(tmp), 2) = DL(i, 2) bao hàm rộng hơn là KQ(j, 2) = DL(i, 2). Nó chỉ bằng nhau trong lần đầu tiên thôi

(nói cách khác là nếu trong trường hợp đã có rồi thì chỉ có khái niệm Dic.Item(tmp) mà không tồn tại j?)

Ở bài toán của bạn:
- Khi ta Add cặp Key, Item vào Dictionary, ta "cố tình" gán Item chính là vị trí của mảng KQ ---> Mục đích để lần sau biết đường mà tìm
- Lần đầu vòng lập, do Key chưa tồn tại nên được gán vào dòng thứ nhất của bảng tra... Trong đó Key đầu tiên sẽ = 01-01-2012 và Item sẽ =1
- Lần thứ 2 của vòng lập, ta thấy Key đã tồn tại, ta sẽ dùng chính Key này để tra ra Item (chính là giá trị j) ---> Từ đó gán giá trị DL(i,2) vào vị trí cột 2, dòng j của mảng KQ... Tại thời điểm này thì Dic.Item(tmp) sẽ = 1 ==> KQ(Dic.Item(tmp), 2) sẽ = KQ(1 , 2)
- Tường tự thế cho các lần lập thứ 3 trở đi
------------
Nói tóm lại:
- Hãy tưởng tượng Dictionary là 1 bảng tra 2 cột nhiều dòng, với cột 1 = Keys và cột 2 = Items
- Cột 1 luôn là các phần tử duy nhất và bắt buộc phải có
- Cột 2 là bất cứ giá trị nào và cũng không bắt buộc phải có
- Để tra 1 Item nào đó ta phải thông qua Key tương ứng của nó bằng lệnh Dic.Item(Key)
- Việc tra này tương đương với cách dùng VLOOKUP trong bảng tính

trungvdb · 11/2/12

Cảm ơn thày, nhờ thày giảng tôi đã hoàn toàn hiểu rồi, hóa ra trước tôi hiểu sai vấn đề về Dic.Item(tmp) . Về bản chất j= Dic.Item(tmp)
(2 thằng này thực chất là 1 thằng, j chẳng qua là viết tắt thay cho Dic.Item(tmp)

Nguyên nhân có 2 kết quả khác nhau là do vị trí đặt KQ(j, 2) = DL(i, 2) trước End If hay sau End If quyết định. Sở dĩ giá trị cột E thay đổi là do DL(i,2) nó đã được chuyển từ ô trước xuống ô sau (do i tăng lên 1 đơn vị khi chuyển sang vòng lặp kế tiếp).

* Code này nó sẽ lấy giá trị cột B cuối cùng:

PHP:

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
      End If
      KQ(j, 2) = DL(i, 2)
    End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

* Nếu chỉ cần thay đổi dòng KQ(j, 2) = DL(i, 2) về trước End If thì nó lấy giá trị cột B dòng đầu tiên

PHP:

Sub Loc()
  Dim DL, KQ, i As Long, j As Long, Dic As Object, tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  DL = Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
  ReDim KQ(1 To UBound(DL, 1), 1 To 2)
  For i = 1 To UBound(DL, 1)
    If DL(i, 1) <> "" Then
      tmp = DL(i, 1)
      If Not Dic.Exists(tmp) Then
        j = j + 1
        Dic.Add tmp, j
        KQ(j, 1) = tmp
       KQ(j, 2) = DL(i, 2)
      End If
     End If
  Next
  If j Then Range("D1").Resize(j, 2).Value = KQ
End Sub

ndu96081631 · 11/2/12

trungvdb đã viết:
Cảm ơn thày, nhờ thày giảng tôi đã hoàn toàn hiểu rồi, hóa ra trước tôi hiểu sai vấn đề về Dic.Item(tmp) . Về bản chất j= Dic.Item(tmp)
(2 thằng này thực chất là 1 thằng, j chẳng qua là viết tắt thay cho Dic.Item(tmp)

Mời bạn xem thêm bài trích lọc và tổng hợp theo điều kiện (có cộng dồn) tại đây để thấy vai trò của Item trong việc đánh dấu vị trí:
http://www.giaiphapexcel.com/forum/...-báo-cáo-từ-ngày-đến-ngày&p=375970#post375970

nmhung49 · 13/2/12

Mình có 1 bài tập này mong các bạn iu thích về mảng tham gia giải đáp Mình có 2 cột 1 cột sản phẩm 1 cột code khách hàng bây giờ mình muốn đếm sản phẩm đó tương ứng với khách hàng đó mua bao nhiêu lần rồi cho ra kết quả ở cột G2 --> K2 v..v.. Cái này dùng Pivot thì OK
Anh Ndu tham gia sau cùng nhen

ThuNghi · 13/2/12

nmhung49 đã viết:
Mình có 1 bài tập này mong các bạn iu thích về mảng tham gia giải đáp Mình có 2 cột 1 cột sản phẩm 1 cột code khách hàng bây giờ mình muốn đếm sản phẩm đó tương ứng với khách hàng đó mua bao nhiêu lần rồi cho ra kết quả ở cột G2 --> K2 v..v.. Cái này dùng Pivot thì OK
Anh Ndu tham gia sau cùng nhen

Bài này NDU đã làm 1 code rất tổng quát về sum, max, min ...
Nhưng đang đang buồn làm thử lại xem.

PHP:

Sub TaoBC()
Dim endR&, i&, iR&, iC&, nR&, nC&
Dim Arr, ArrKQ
Dim Tmp01$, Tmp02$
Dim Dic01 As Object, Dic02 As Object
Set Dic01 = CreateObject("Scripting.Dictionary")
Set Dic02 = CreateObject("Scripting.Dictionary")
With Sheets("Data")
  .AutoFilterMode = False
  endR = .Cells(65000, 1).End(3).Row
  Arr = .Range(.Cells(2, 1), .Cells(endR, 2)).Value
End With
ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr))
iR = 1: iC = 1
For i = 1 To UBound(Arr)
  If Len(CStr(Arr(i, 1))) > 0 And Len(CStr(Arr(i, 2))) > 0 Then
    Tmp01 = CStr(Arr(i, 2))
    If Not Dic01.Exists(Tmp01) Then
      iR = iR + 1
      Dic01.Add Tmp01, iR
      ArrKQ(iR, 1) = Tmp01
    End If
    Tmp02 = Arr(i, 1)
    If Not Dic02.Exists(Tmp02) Then
      iC = iC + 1
      Dic02.Add Tmp02, iC
      ArrKQ(1, iC) = Tmp02
    End If
    nR = Dic01.Item(Tmp01)
    nC = Dic02.Item(Tmp02)
    ArrKQ(nR, nC) = ArrKQ(nR, nC) + 1
  End If
Next i
If iR And iC Then
  With Sheets("sheet2")
    .Cells.ClearContents
    .[A1].Resize(iR, iC) = ArrKQ
  End With
End If
Erase Arr, ArrKQ
Set Dic01 = Nothing: Set Dic02 = Nothing
End Sub

Hùng kiểm tra lại nhé.

nmhung49 · 13/2/12

ThuNghi đã viết:
Bài này NDU đã làm 1 code rất tổng quát về sum, max, min ...
Nhưng đang đang buồn làm thử lại xem.
Hùng kiểm tra lại nhé.

Dạ hoàn toàn chính xác nhưng anh có thể nâng cấp lên dùng 1 Dic được không, em nghĩ dùng 1 Dic code sẽ gắn và tốc độ cũng tăng lên đáng kể. Thanks anh đã tham gia

concogia · 13/2/12

nmhung49 đã viết:
Dạ hoàn toàn chính xác nhưng anh có thể nâng cấp lên dùng 1 Dic được không, em nghĩ dùng 1 Dic code sẽ gắn và tốc độ cũng tăng lên đáng kể. Thanks anh đã tham gia

Một cách làm ....một "Dít" đây, còn tốc độ thì....cóc biết vì có một nhúm dữ liệu hè.

Mã:

Public Sub MotDit()
    Dim Vung, d, I, J, Tach, Mg(), K, kK, A, aA, iDong, iCot
    Set d = CreateObject("scripting.dictionary")
    Vung = Range([A2], [A100000].End(xlUp)).Resize(, 2).Value
    K = 1: kK = 1
        For J = 1 To UBound(Vung, 2)
            For I = 1 To UBound(Vung, 1)
                If Not d.exists(Vung(I, J)) Then
                        If J = 1 Then
                            K = K + 1
                            d.Add Vung(I, J), 1 & " " & K & " " & K
                        Else
                            kK = kK + 1
                            d.Add Vung(I, J), kK & " " & 1 & " " & kK
                        End If
                End If
            Next I
        Next J
            ReDim Mg(1 To d.Count, 1 To d.Count)
            A = d.items: aA = d.keys
            For I = 0 To d.Count - 1
                Tach = Split(A(I))
                Mg(Tach(0), Tach(1)) = aA(I)
            Next I
                For I = 1 To UBound(Vung)
                    iDong = Split(d.Item(Vung(I, 2)))
                    iCot = Split(d.Item(Vung(I, 1)))
                    Mg(iDong(2), iCot(2)) = Mg(iDong(2), iCot(2)) + 1
                Next I
    Range([f1], [XX1].End(xlToLeft)).Resize(100000).ClearContents
    [f1].Resize(UBound(Mg, 1), UBound(Mg, 2)) = Mg
End Sub

nmhung49 · 13/2/12

concogia đã viết:
Một cách làm ....một "Dít" đây, còn tốc độ thì....cóc biết vì có một nhúm dữ liệu hè.

Bác Cò già vẫn phong độ như ngày xưa, em đã test thử dùng 1 Dic với 2 Dic thì thấy tốc độ 2 Dic cao hơn với dữ liệu nhiều. Cảm ơn anh ThuNghi và Chú Còn già đã giúp đỡ. Đoạn code của em cũng giống anh ThuNghi thôi...

PHP:

Sub Tonghop()
    Dim VDL As Variant, KQ() As Variant, I As Long, N As Long, J As Long
    Dim Dic As Object, T As Double
    T = Timer
    Set Dic = CreateObject("Scripting.Dictionary")
    VDL = Range("a2:b46").Value
    ReDim KQ(1 To UBound(VDL, 1), 1 To 7)
    N = 1: J = 1
    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(VDL, 1)
            If Not .Exists(VDL(I, 2)) Then
                N = N + 1
                KQ(N, 1) = VDL(I, 2)
                .Item(VDL(I, 2)) = N
            End If
            If Not Dic.Exists(VDL(I, 1)) Then
                J = J + 1
                Dic(VDL(I, 1)) = J
                KQ(1, J) = VDL(I, 1)
            End If
            KQ(.Item(VDL(I, 2)), Dic(VDL(I, 1))) = KQ(.Item(VDL(I, 2)), Dic(VDL(I, 1))) + 1
        
        Next
    End With
   
    With Range("R1")
        .CurrentRegion.ClearContents
        .Resize(N, J).Value = KQ
    End With
    Set Dic = Nothing
    Range("C3").Value = Timer - T
End Sub

ndu96081631 · 13/2/12

nmhung49 đã viết:
Bác Cò già vẫn phong độ như ngày xưa, em đã test thử dùng 1 Dic với 2 Dic thì thấy tốc độ 2 Dic cao hơn với dữ liệu nhiều. Cảm ơn anh ThuNghi và Chú Còn già đã giúp đỡ. Đoạn code của em cũng giống anh ThuNghi thôi...

PHP:

Sub Tonghop() Dim VDL As Variant, KQ() As Variant, I As Long, N As Long, J As Long Dim Dic As Object, T As Double T = Timer Set Dic = CreateObject("Scripting.Dictionary") VDL = Range("a2:b46").Value ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ''.....................

2 Dic cũng chưa chắc chậm hơn, ăn tiền ở chổ người ta dùng có 1 vòng lập
Ẹc... Ẹc...
Nếu tôi làm thì cũng thế thôi, tuy nhiên xin góp ý chổ này
- ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ---> Sao bạn biết chắc là 7 cột?
Còn ThuNghi thì viết vầy:
- ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr)) ---> Sẽ lỗi nghiêm trọng nếu dữ liệu lớn
Vì vậy để chắc ăn nên dùng ReDim Preserve cho chiều thứ 2
Tôi giả lập 65536 dòng dữ liệu rồi, mọi người cứ lấy mà thí nghiệm

Hoàng Trọng Nghĩa · 13/2/12

ndu96081631 đã viết:
2 Dic cũng chưa chắc chậm hơn, ăn tiền ở chổ người ta dùng có 1 vòng lập
Ẹc... Ẹc...
Nếu tôi làm thì cũng thế thôi, tuy nhiên xin góp ý chổ này
- ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ---> Sao bạn biết chắc là 7 cột?
Còn ThuNghi thì viết vầy:
- ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr)) ---> Sẽ lỗi nghiêm trọng nếu dữ liệu lớn
Vì vậy để chắc ăn nên dùng ReDim Preserve cho chiều thứ 2
Tôi giả lập 65536 dòng dữ liệu rồi, mọi người cứ lấy mà thí nghiệm

Thử cái này xem có được không ạ? Theo File của Thầy (65536 dòng):

PHP:

Sub Array2Dicts()
    Dim i As Long, j As Long, iC As Long, iR As Long
    Dim 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
            MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) = MyArr(.Item(sArray(i, 2)), MyDict(sArray(i, 1))) + 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

Cẩn thận: Với Excel 2003, Khi B65536 có dữ liệu, các bạn không thể dùng cấu trúc này:

sArray = Range(Sheet1.[A2], Sheet1.[B65536].End(xlUp)).Value

(nếu dùng nó sẽ nhận dữ liệu có thể tương đương với Range("A1:B2") hoặc không lấy hết dữ liệu).

mà bắt buộc phải dùng cấu trúc này:

sArray = Sheet1.Range("A2:B65536").Value

ndu96081631 · 13/2/12

minhthien321 đã viết:
Thử cái này xem có được không ạ? Theo File của Thầy (65536 dòng):

Nếu khéo 1 chút thì vẫn có thể tăng tốc thêm được nữa đấy Ngoài ra xin nói thêm với nmhung49: Cách dùng 1 Dictionary chỉ đúng nếu bảo đảm chắc chắn rằng các phần tử ở 2 cột A, B là không bao giờ trùng nhau, nếu không sẽ cho kết quả sai quá xa luôn ---> Vậy tổng quát nhất vẫn nên dùng 2 Dic

Hoàng Trọng Nghĩa · 13/2/12

ndu96081631 đã viết:
Nếu khéo 1 chút thì vẫn có thể tăng tốc thêm được nữa đấy
Ngoài ra xin nói thêm với nmhung49: Cách dùng 1 Dictionary chỉ đúng nếu bảo đảm chắc chắn rằng các phần tử ở 2 cột A, B là không bao giờ trùng nhau, nếu không sẽ cho kết quả sai quá xa luôn ---> Vậy tổng quát nhất vẫn nên dùng 2 Dic

Thầy cứ úp úp mở mở làm em chẳng biết mô tê gì cả, Thầy làm luôn đi Thầy ơi!

ndu96081631 · 13/2/12

minhthien321 đã viết:
Thầy cứ úp úp mở mở làm em chẳng biết mô tê gì cả, Thầy làm luôn đi Thầy ơi!

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 p1 và p2 là 2 biến Long
Thí nghiệm xem có nhanh hơn không?
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 13/2/12

ndu96081631 đã viết:
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 p1 và p2 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

Hoàng Trọng Nghĩa · 13/2/12

À, 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!

ndu96081631 · 13/2/12

minhthien321 đã viết:
Đú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ì

LinDan · 14/2/12

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

Hoàng Trọng Nghĩa · 14/2/12

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

ThuNghi · 14/2/12

LinDan đã viết:
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

LinDan · 14/2/12

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.

ThuNghi · 14/2/12

LinDan đã viết:
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

LinDan · 14/2/12

ThuNghi đã viết:
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.

LinDan · 14/2/12

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

ThuNghi · 14/2/12

LinDan đã viết:
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

ndu96081631 · 14/2/12

LinDan đã viết:
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

LinDan · 14/2/12

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ử.

trungvdb · 14/2/12

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

Hoàng Trọng Nghĩa · 14/2/12

trungvdb đã viết:
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)

trungvdb · 14/2/12

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ỉ?

ndu96081631 · 14/2/12

LinDan đã viết:
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

Hoàng Trọng Nghĩa · 14/2/12

trungvdb đã viết:
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!

ndu96081631 · 14/2/12

trungvdb đã viết:

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

trungvdb · 14/2/12

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

ndu96081631 · 14/2/12

trungvdb đã viết:
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)

Suy nghĩ xem có thể làm được bài này chỉ với 1 vòng lập không?
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 14/2/12

ndu96081631 đã viết:
Suy nghĩ xem có thể làm được bài này chỉ với 1 vòng lập không?
Ẹc... Ẹc...

Làm thử cho vui, không biết đúng ý Thầy không:

PHP:

Sub Loc2()
    Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, m As Long
    Dongcuoi = Sheet1.[A65000].End(xlUp).Row
    DL = Sheet1.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)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(DL, 1)
            If i < 9 Then
                Tmp = Arr(i - 1)
                If Not .Exists(Tmp) Then .Add Tmp, ""
            End If
            If .Exists(DL(i, 1)) Then
                m = m + 1
                KQ(m, 1) = DL(i, 1): KQ(m, 2) = DL(i, 2)
            End If
        Next
    End With
    With Sheets("sheet2")
        .Range("A:B").ClearContents
        .[A2].Resize(m, 2).Value = KQ
    End With
End Sub

Nhưng cũng e là dữ liệu nhỏ hơn 8 hàng thì sao ta? Ẹc ... Ẹc ...

trungvdb · 14/2/12

Bác Nghĩa đúng là số đỏ quá gặp ngay dữ liệu bài này cho luôn các phần tử Arr nhỏ hơn 9. Thế nhưng trường hợp tổng quát các phần tử củ Arr không tuân theo quy luật nào mà nó là các số ngẫu nhiêu cho vào thì sao ? Hihi

Chắc ý của thày là giải quyết cho dữ liệu tổng quát bác ah

ndu96081631 · 14/2/12

trungvdb đã viết:
Lời giải của bác Nghĩa gặp may trong dữ liệu cụ thể của bài này (chỉ đúng trong TH các phần tử Arr nhỏ hơn 9 thôi), thế trường hợp tổng quát các phần tử củ Arr không tuân theo quy luật nào mà nó là các số ngẫu nhiêu cho vào thì sao ?

Chắc ý của thày là giải quyết cho dữ liệu tổng quát bác ah

Hoặc giả Arr chứa các phần tử là Text chẳng hạn
Ẹc... Ẹc...

nmhung49 · 15/2/12

ndu96081631 đã viết:
2 Dic cũng chưa chắc chậm hơn, ăn tiền ở chổ người ta dùng có 1 vòng lập
Ẹc... Ẹc...
Nếu tôi làm thì cũng thế thôi, tuy nhiên xin góp ý chổ này
- ReDim KQ(1 To UBound(VDL, 1), 1 To 7) ---> Sao bạn biết chắc là 7 cột?
Còn ThuNghi thì viết vầy:
- ReDim ArrKQ(1 To UBound(Arr), 1 To UBound(Arr)) ---> Sẽ lỗi nghiêm trọng nếu dữ liệu lớn
Vì vậy để chắc ăn nên dùng ReDim Preserve cho chiều thứ 2
Tôi giả lập 65536 dòng dữ liệu rồi, mọi người cứ lấy mà thí nghiệm

Nếu ta không biết trước phần tử thì nên dùng Preserve đúng như lời anh Ndu nói và gợi ý vậy mình sửa lại ví dụ bài #251 với dữ liệu 65000 dòng thì tốc độ tăng lên đáng kể

PHP:

Sub Tonghop()
    Dim VDL As Variant, KQ() As Variant, I As Long, N As Long, J As Long
    Dim Dic As Object, T As Double, P1 As Long, P2 As Long
    T = Timer
    Set Dic = CreateObject("Scripting.Dictionary")
    VDL = Range("a2:b65536").Value
    ReDim KQ(1 To UBound(VDL, 1), 1 To 1)
    N = 1: J = 1
    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(VDL, 1)
            If Not .Exists(VDL(I, 2)) Then
                N = N + 1
                KQ(N, 1) = VDL(I, 2)
                .Item(VDL(I, 2)) = N
            End If
            If Not Dic.Exists(VDL(I, 1)) Then
                J = J + 1
                Dic(VDL(I, 1)) = J
                If J > UBound(KQ, 2) Then
                    ReDim Preserve KQ(1 To UBound(KQ, 1), 1 To J)
                End If
                KQ(1, J) = VDL(I, 1)
            End If
            P1 = .Item(VDL(I, 2)): P2 = Dic(VDL(I, 1))
            KQ(P1, P2) = KQ(P1, P2) + 1
        
        Next
    End With
   
    With Range("R1")
        .CurrentRegion.ClearContents
        .Resize(N, J).Value = KQ
    End With
    Set Dic = Nothing
    Range("C3").Value = Timer - T
End Sub

nmhung49 · 15/2/12

Hoàng Trọng Nghĩa đã viết:
Nhưng cũng e là dữ liệu nhỏ hơn 8 hàng thì sao ta? Ẹc ... Ẹc ...

Dùng thêm hàm Match của Excel vô chứ sao ta he...he...

ThuNghi · 15/2/12

nmhung49 đã viết:
Dùng thêm hàm Match của Excel vô chứ sao ta he...he...

Nếu kg dùng match hay Instr thì tạm thời chưa biết cách làm 1 for.
NDU làm thử, cám ơn!

ndu96081631 · 15/2/12

nmhung49 đã viết:
Dùng thêm hàm Match của Excel vô chứ sao ta he...he...

Nếu cóc cho dùng bất kỳ thứ gì liên quan đên WorksheetFunction thì sao đây?
Ẹc... Ẹc...

nmhung49 · 16/2/12

ndu96081631 đã viết:
Nếu cóc cho dùng bất kỳ thứ gì liên quan đên WorksheetFunction thì sao đây?
Ẹc... Ẹc...

Thì dùng hàm InStr của VBA nhưng anh ThuNghi nói, không biết anh Ndu có cao kiến gì không cho anh em học hỏi đi

ndu96081631 · 16/2/12

nmhung49 đã viết:
Thì dùng hàm InStr của VBA nhưng anh ThuNghi nói, không biết anh Ndu có cao kiến gì không cho anh em học hỏi đi

Dùng toán tự Like là được rồi...
Thuật toán:

PHP:

sArray = Sheet1.Range("A2:B100").Value
ReDim Arr(1 To UBound(sArray, 1), 1 To 2)
tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Crit = Chr(0) & Join(tmpArr, Chr(0)) & Chr(0)
For i = 1 To UBound(sArray, 1)
  tmp = "*" & Chr(0) & sArray(i, 1) & Chr(0) & "*"
  If Crit Like tmp Then
    m = m + 1
    Arr(m, 1) = sArray(i, 1)
    Arr(m, 2) = sArray(i, 2)
  End If
Next

ThuNghi · 16/2/12

ndu96081631 đã viết:

Dùng toán tự Like là được rồi...
Thuật toán:

PHP:

sArray = Sheet1.Range("A2:B100").Value
ReDim Arr(1 To UBound(sArray, 1), 1 To 2)
tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Crit = Chr(0) & Join(tmpArr, Chr(0)) & Chr(0)
For i = 1 To UBound(sArray, 1)
  tmp = "*" & Chr(0) & sArray(i, 1) & Chr(0) & "*"
  If Crit Like tmp Then
    m = m + 1
    Arr(m, 1) = sArray(i, 1)
    Arr(m, 2) = sArray(i, 2)
  End If
Next

Quá hay nhưng vẫn chậm hơn Instr
Với tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8) thì dùng like hay instr sẽ nhanh hơn Dic với dữ liệu 60.000 rows.
Nhưng thay những số 1,2 ... kia thành text thì Dic nhanh hơn.
Cám ơn NDU.
Dùng Instr

PHP:

sArray = Sheet1.Range("A2:B60000").Value
ReDim Arr(1 To UBound(sArray, 1), 1 To 2)
tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8)
Crit = Join(tmpArr, vbBack)
For i = 1 To UBound(sArray, 1)
  Tmp = sArray(i, 1) & vbBack
  If InStr(Crit, Tmp) Then
    m = m + 1
    Arr(m, 1) = sArray(i, 1)
    Arr(m, 2) = sArray(i, 2)
  End If
Next

ndu96081631 · 16/2/12

ThuNghi đã viết:
Quá hay nhưng vẫn chậm hơn Instr
Với tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8) thì dùng like hay instr sẽ nhanh hơn Dic với dữ liệu 60.000 rows.
Nhưng thay những số 1,2 ... kia thành text thì Dic nhanh hơn.
Cám ơn NDU.
Dùng Instr

PHP:

sArray = Sheet1.Range("A2:B60000").Value ReDim Arr(1 To UBound(sArray, 1), 1 To 2) tmpArr = Array(1, 2, 3, 4, 5, 6, 7, 8) Crit = Join(tmpArr, vbBack) For i = 1 To UBound(sArray, 1) Tmp = sArray(i, 1) & vbBack If InStr(Crit, Tmp) Then m = m + 1 Arr(m, 1) = sArray(i, 1) Arr(m, 2) = sArray(i, 2) End If Next

Sửa lại chổ này chút:
Crit = Join(tmpArr, vbBack) & vbBack
Nếu không sẽ mất điều kiện = 8

trungvdb · 17/2/12

Hỏi về cách viết Code chèn dòng

Tôi đang học code chèn dòng nhưng cú pháp viết chắc chưa đúng, xin chỉ giúp chỗ sai và sửa lại giúp dùm

PHP:

Sub Chendong()
Dim DL(), i As Long
DL = Range([A1], [A65000].End(xlUp)).Value
For i = UBound(DL, 1) To 1
If DL(i, 1) <> "" Then
DL(i, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

ndu96081631 · 17/2/12

trungvdb đã viết:
Tôi đang học code chèn dòng nhưng cú pháp viết chắc chưa đúng, xin chỉ giúp chỗ sai và sửa lại giúp dùm

PHP:

Sub Chendong() Dim DL(), i As Long DL = Range([A1], [A65000].End(xlUp)).Value For i = UBound(DL, 1) To 1 If DL(i, 1) <> "" Then DL(i, 1).Select Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove End If Next End Sub

Dim DL() ---> Chứng tỏ DL là mảng ---> Vậy DL(i, 1).Select là sai ---> Chỉ có Range mới Select được
For i = UBound(DL, 1) To 1 ---> Là quét ngược từ dưới lên ---> Vậy phải thêm Step -1 vào mới được (For i = UBound(DL, 1) To 1 Step -1)

trungvdb · 17/2/12

Nhờ thày Ndu mà tôi mới tỉnh ngộ được ra vấn đề, mảng là chỉ có giá trị không thôi, thiếu các thuộc tính khác như Cells, Range nên không thể Select được. Code viết đúng là

PHP:

Sub Chendong()
Dim DL As Range, i As Long
Set DL = Range([A1], [A65000].End(xlUp))
KQ = DL.Value
For i = UBound(KQ, 1) To 1 Step -1
If KQ(i, 1) <> "" Then
DL(i, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

Bỏ Select đi cho gọn

PHP:

Sub Chendong()
Dim DL As Range, i As Long
Set DL = Range([A1], [A65000].End(xlUp))
KQ = DL.Value
For i = UBound(KQ, 1) To 1 Step -1
If KQ(i, 1) <> "" Then
DL(i, 1).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

------------
Xin thày, mọi người chỉ bảo thêm: Khi chạy Code này những dòng mà tại đó ô cột A có dữ liệu thì nó tự động chèn dòng mới lên ngay phía trên dòng lựa chọn; nhưng nếu cần yêu cầu ngược lại dòng được chèn ở phía dưới dòng được chọn thì thay đổi Code như thế nào?

ndu96081631 · 17/2/12

trungvdb đã viết:
nhưng nếu cần yêu cầu ngược lại dòng được chèn ở phía dưới dòng được chọn thì thay đổi Code như thế nào?

Sửa vòng lập thành vầy thử xem:

Mã:

[/B]For i = UBound(KQ, 1) [COLOR=#ff0000][B]To 2[/B][/COLOR] Step -1 If [COLOR=#ff0000][B]KQ(i - 1, 1)[/B][/COLOR] <> "" Then

trungvdb · 17/2/12

Tôi chợt nghĩ ra

PHP:

Sub Chendong()
Dim DL As Range, i As Long
Set DL = Range([A1], [A65000].End(xlUp))
KQ = DL.Value
For i = UBound(KQ, 1) To 1 Step -1
If KQ(i, 1) <> "" Then
DL(i+1, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

ThuNghi · 17/2/12

trungvdb đã viết:

Tôi chợt nghĩ ra

PHP:

Sub Chendong()
Dim DL As Range, i As Long
Set DL = Range([A1], [A65000].End(xlUp))
KQ = DL.Value
For i = UBound(KQ, 1) To 1 Step -1
If KQ(i, 1) <> "" Then
DL(i+1, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

Sao kg chèn vào Arr (KQ) 1 lần sau đó gán xuống sh.

PHP:

Sub Chendong2()
Dim DL, i As Long, s&
Dim KQ
DL = Range([A1], [A65000].End(xlUp)).Value
ReDim KQ(1 To UBound(DL, 1) * 2, 1 To 1)
For i = 1 To UBound(DL, 1)
  s = s + 1
  KQ(s, 1) = DL(i, 1)
  If DL(i, 1) <> "" Then
    s = s + 1
    KQ(s, 1) = ""
  End If
Next
Cells(1, 1).Resize(s) = KQ
End Sub

trungvdb · 17/2/12

Xin bái phục bác ThuNghi, cách làm của bác rất sáng tạo

(thích nhất 2 câu lệnh s=s+1 >> s=2*i của bác)

Tuy vậy, nếu ứng dụng vào thực tế (thường một bảng có nhiều cột) sẽ khiến dòng các dòng cột A sẽ bị đẩy xuống dưới, trong khi số liệu các côt khác vẫn đứng yên. Do vậy dữ liệu không còn chuẩn nữa.

viehoai · 17/2/12

Chèn mãng vào mãng
Giả sửa tôi có 2 mãng như file đính kèm
Kính nhờ các anh chi thuật toán (hoặc có code luôn càng tốt) để chèn 1 mãng thứ 2 vào mãng thứ nhất theo 1 điều kiện
Xin cảm ơn các anh chị

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ó

Thành viên gắn bó

Thành viên gắn bó

Bad Excel Member

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Bad Excel Member

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên thường trực

Bad Excel Member

Bad Excel Member

Thành viên thường trực

Thành viên thường trực

File đính kèm

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

File đính kèm

Thành viên thường trực

File đính kèm

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

File đính kèm

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Chuyên gia GPE

Thành viên thường trực

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

Huyền thoại GPE

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Huyền thoại GPE

Thành viên thường trực

File đính kèm

Huyền thoại GPE

Thành viên thường trực

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

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

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

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

File đính kèm

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

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

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

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

File đính kèm

Huyền thoại GPE

File đính kèm

Chuyên gia GPE

Huyền thoại GPE

Chuyên gia GPE

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

Huyền thoại GPE

Thành viên tiêu biểu

Chuyên gia GPE

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