Làm sao sử dụng redim preserve trong bài này (1 người xem)

Quang_Hải · 29/6/12

Bài này mình khai báo arr( 1 to 100, 1 to 3) vì không biết kích cỡ của mãng. Mình muốn tiếp cận với redim preserve qua bài này nhưng không biết làm cách nào. Dự định sẽ redim arr trong vòng lập khi add dữ liệu vào dic thì sử dụng j=j+1 để redim arr lại, nhưng loay hoay mãi không làm nổi.

PHP:

Sub test_redim_preserve()
Dim dic As Object
Dim dl As Variant, i As Long, j As Integer, k As Byte
Dim arr(1 To 100, 1 To 3)
Set dic = CreateObject("scripting.dictionary")
dl = Range([a1], [d65536].End(3)).Value
With dic
    For i = 1 To UBound(dl, 1)
        dk = dl(i, 1) & "," & dl(i, 2) & "," & dl(i, 3)
        If Not .exists(dk) Then
            j = j + 1
            .Add dk, dl(i, 4)
            For k = 1 To 3
                arr(j, k) = dl(i, k)
            Next
        Else
            .Item(dk) = .Item(dk) + dl(i, 4)
        End If
    Next
[e1].Resize(j, 3) = arr
[h1].Resize(.Count, 1) = Application.Transpose(.items)
End With
End Sub

concogia · 29/6/12

quanghai1969 đã viết:
Bài này mình khai báo arr( 1 to 100, 1 to 3) vì không biết kích cỡ của mãng. Mình muốn tiếp cận với redim preserve qua bài này nhưng không biết làm cách nào. Dự định sẽ redim arr trong vòng lập khi add dữ liệu vào dic thì sử dụng j=j+1 để redim arr lại, nhưng loay hoay mãi không làm nổi.

PHP:

Sub test_redim_preserve() Dim dic As Object Dim dl As Variant, i As Long, j As Integer, k As Byte Dim arr(1 To 100, 1 To 3) Set dic = CreateObject("scripting.dictionary") dl = Range([a1], [d65536].End(3)).Value With dic For i = 1 To UBound(dl, 1) dk = dl(i, 1) & "," & dl(i, 2) & "," & dl(i, 3) If Not .exists(dk) Then j = j + 1 .Add dk, dl(i, 4) For k = 1 To 3 arr(j, k) = dl(i, k) Next Else .Item(dk) = .Item(dk) + dl(i, 4) End If Next [e1].Resize(j, 3) = arr [h1].Resize(.Count, 1) = Application.Transpose(.items) End With End Sub

1- Nếu không biết số dòng của mảng thì khai báo bằng số dòng của mảng dl chứ sao lại khai báo 100 ==> liều thật
2- Hình như không Redim Preserve theo chiều thứ nhất của mảng được ==> "Tờ eo teo huyền TÈO"
3- Nếu cố tính muốn sử dụng Redim Preserve thì theo ý mình bạn cho kết quả vào chiều thứ hai, sau đó dùng thêm vòng lặp lấy kết quả vào chiều thứ nhất của mảng kết quả

Mã:

Sub test_redim_preserveAAA()
    Dim dic As Object, Arr, dk, Kq, Tach
    Dim dl As Variant, I As Long, J As Integer, k As Byte
    Set dic = CreateObject("scripting.dictionary")
    dl = Range([a1], [d65536].End(3)).Value
    ReDim Arr(1 To 1, 1 To 1)
        With dic
            For I = 1 To UBound(dl, 1)
                dk = dl(I, 1) & " " & dl(I, 2) & " " & dl(I, 3)
                If Not .exists(dk) Then
                    J = J + 1
                    .Add dk, dl(I, 4)
                    ReDim Preserve Arr(1 To 1, 1 To J)
                        Arr(1, J) = dk
                Else
                    .Item(dk) = .Item(dk) + dl(I, 4)
                End If
            Next I
                    ReDim Kq(1 To UBound(Arr, 2), 1 To 3)
                    For I = 1 To UBound(Arr, 2)
                        Tach = Split(Arr(1, I))
                            For J = 0 To 2
                                Kq(I, J + 1) = Tach(J)
                            Next J
                    Next I
            [l1].Resize(UBound(Arr, 2), 3) = Kq
            [o1].Resize(.Count, 1) = Application.Transpose(.items)
        End With
End Sub

Cái này là ý riêng của mình & sẵn code của bạn mình sửa luôn cho nhanh
Thân

Quang_Hải · 30/6/12

Hèn gì mình redim chiều thứ nhất hoài không đựơc, đọc sách nào cũng thấy ví dụ chiều thứ 2 thôi.
Thanks

siwtom · 30/6/12

quanghai1969 đã viết:
Hèn gì mình redim chiều thứ nhất hoài không đựơc, đọc sách nào cũng thấy ví dụ chiều thứ 2 thôi.
Thanks

Tôi thấy tiếc cho thời gian của bạn. Cái này được viết rõ ràng trong help mà (tôi dùng Excel 2007). Bạn đọc sách nhưng cái sách gần nhất thì bạn quên rồi. Trích

If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all. For example, if your array has only one dimension, you can resize that dimension because it is the last and only dimension. However, if your array has two or more dimensions, you can change the size of only the last dimension and still preserve the contents of the array

Về code nếu không bắt buộc dùng Redim Preserve (bạn chủ ý dùng để học?) thì ta cứ thêm vào Dic bình thường, sau đó Redim 1 lần duy nhất. Sau khi có Dic rồi thì lấy Keys rồi tách ra.

PHP:

Sub test_redim_preserve()
Dim dic As Object, Arr, tmpArr, tmp
Dim dl As Variant, i As Long, j As Integer, k As Byte
Set dic = CreateObject("scripting.dictionary")
dl = Range([a1], [d65536].End(3)).Value
With dic
    For i = 1 To UBound(dl, 1)
        dk = dl(i, 1) & "," & dl(i, 2) & "," & dl(i, 3)
        If Not .exists(dk) Then
            .Add dk, dl(i, 4)
        Else
            .Item(dk) = .Item(dk) + dl(i, 4)
        End If
    Next
    ReDim Arr(0 To dic.Count - 1, 1 To 3)
    tmpArr = .Keys
    For i = 0 To dic.Count - 1
        tmp = Split(tmpArr(i), ",")
        For j = 0 To 2
            Arr(i, j + 1) = tmp(j)
        Next j
    Next i
    [e1].Resize(.Count, 3) = Arr
    [h1].Resize(.Count, 1) = Application.Transpose(.items)
End With
End Sub

Nếu cố tình dùng Redim Preserve như bạn concogia thì tôi nghĩ không cần "cho kết quả vào chiều thứ hai". Đơn giản là lúc đó ta dùng mảng 1 chiều thôi.

Mã:

Sub test_redim_preserveAAA()
    Dim dic As Object, Arr, dk, Kq, Tach
    Dim dl As Variant, I As Long, J As Integer, k As Byte
    Set dic = CreateObject("scripting.dictionary")
    dl = Range([a1], [d65536].End(3)).Value
    ReDim Arr(1 To 1)
        With dic
            For I = 1 To UBound(dl, 1)
                dk = dl(I, 1) & " " & dl(I, 2) & " " & dl(I, 3)
                If Not .exists(dk) Then
                    J = J + 1
                    .Add dk, dl(I, 4)
                    [COLOR=#ff0000]ReDim Preserve Arr(1 To J)
[/COLOR]                        [COLOR=#ff0000]Arr(J) = dk[/COLOR]
                Else
                    .Item(dk) = .Item(dk) + dl(I, 4)
                End If
            Next I
                    ReDim Kq(1 To [COLOR=#ff0000].Count[/COLOR], 1 To 3)
                    For I = 1 To [COLOR=#ff0000].Count[/COLOR]
                        Tach = Split([COLOR=#ff0000]Arr(I))[/COLOR]
                            For J = 0 To 2
                                Kq(I, J + 1) = Tach(J)
                            Next J
                    Next I
            [l1].Resize[COLOR=#ff0000][/COLOR](.[COLOR=#ff0000]Count[/COLOR], 3) = Kq
            [o1].Resize(.Count, 1) = Application.Transpose(.items)
        End With
End Sub

Trong bài của bạn không nhất thiết phải dùng Redim Preserve do đã có Dic để sau đó lấy từ Dic. Thế nếu không dùng Dic vì không cần thiết thì thế nào?
Ta xét vd. tìm và hiện anh sách các tập tin trong thư mục. Có 3 cột là: đường dẫn tới tập tin, Dung lượng, Thời gian tạo.
Có nhiều cách sử lý. vd.
1. Ta dùng mảng 3 dòng và "nhiều cột". Cứ mỗi lần tìm thấy tập tin thì ta Redim Preserve và tăng số cột thêm 1. Cuối cùng ta dùng Application.WorksheetFunction.Transpose để trả về mảng kết quả.
2. Ta dùng mảng 1 chiều tmpArr (chỉ số từ 1). Mỗi lần tìm thấy tập tin ta Redim Preserve và tăng kích thước thêm 3 --> ghi lần lượt 3 "chi tiết" vào 3 ô cuối. Cuối cùng thì;

Mã:

Redim Arr(1 to Ubound(tmpArr) \ 3, 3)
for k = 1 to Ubound(Arr)
     index =  3*(k - 1) + 1
     Arr(k, 1) = tmpArr(index)
     Arr(k, 2) = tmpArr(index + 1)
     Arr(k, 3) = tmpArr(index + 2)
next k

Quang_Hải · 30/6/12

Đang đọc từng chữ theo hướng dẫn của bạn, nhưng để hiểu cặn kẻ chắc phải cần 1 khoảng thời gian nhất định.
Cảm ơn bạn đã chia sẽ kiến thức.

Làm sao sử dụng redim preserve trong bài này (1 người xem)

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

Quang_Hải

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

File đính kèm

concogia

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

Quang_Hải

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

siwtom

Thành viên gắn bó

Quang_Hải

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

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian