Redim trong mảng

[vba_gpe]

Em chào mọi người.

Em mới làm quen với mảng trong VBA. Em tìm trên diễn đàn mình nhiều ví dụ về mảng nhưng đến nay em vẫn chưa tiếp thu được nhiều kiến thức về mảng.
Em có tạo cho mình 1 bài toán để giải quyết bằng cách dùng mảng như sau.
Tính tổng hợp số xe từ 3 hãng Honda, Huyndai, Suzuki của từng đại lý (Như hình).
Theo logic của em qua nhiều bài đã đọc tham khảo từ nhìu bài viết trên diễn đàn?
- Bước 1: Gán mảng arr vùng cần duyệt.
- Bước 2: Duyệt từ trên xuống dưới các giá trị của arr. Nếu có điều kiện đại lý =>Kiểm tra 3 mảng trước đó (honda,suzuki,huyndai) đã có chưa = > Ghi dữ liệu trước đó (nếu có) => Xóa 3 mảng đó và khai báo lại mảng để bắt đầu thêm phần tử vào mảng. Dựa vào 2 từ bắt đầu của nhà sx (Ho,Su,Hu) để thêm các phần tử vào mảng tương ứng.

Em thử code như thế này mong nhận được góp ý của mọi người:

Sub Vidu()
    Dim arr()
    Dim lr As Long
    lr = Range("B" & Rows.Count).End(xlUp).Row
    arr() = Range("A1:D" & lr).Value
    Dim arrHo(), arrHu(), arrSu()
    Dim i As Long
    For i = 1 To lr
        If arr(i, 1) <> "" Then  
            If isarray(arrHo())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrHo()), 2).Value = arrHo
            If isarray(arrHu())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrHu()), 2).Value = arrHu
            If isarray(arrSu())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrSu()), 2).Value = arrSu
            'Reset lai tu dau cac mang??
            ReDim arrHo(1 To UBound(arr()), 1 To 2)
            ReDim arrHu(1 To UBound(arr()), 1 To 2)
            ReDim arrSu(1 To UBound(arr()), 1 To 2)
        Else
            Select Case UCase$(Left(arr(i, 3), 2))
                Case "HO"
                    Dim r1 As Long
                    r1 = r1 + 1
                    arrHo(r1, 1) = arr(i, 2)
                    arrHo(r1, 2) = arr(i, 4)
                Case "HU"
                    Dim r2 As Long
                    r2 = r2 + 1
                    arrHo(r2, 1) = arr(i, 2)
                    arrHo(r2, 2) = arr(i, 4)
                Case "SU"
                    Dim r3 As Long
                    r3 = r3 + 1
                    arrHo(r3, 1) = arr(i, 2)
                    arrHo(r3, 2) = arr(i, 4)
            End Select
        End If
    Next

     If isarray(arrHo())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrHo()), 2).Value = arrHo
     If isarray(arrHu())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrHu()), 2).Value = arrHu
     If isarray(arrSu())  Then Range("G" & Range("G65536").End(xlUp).Row + 1).Resize(UBound(arrSu()), 2).Value = arrSu
 
End Sub

Em cảm ơn mọi người.

 

[huuthang_bd]

Kính gửi thầy Huuthang_bd
Em có một mảng từ A1: D5
Em khai báo mảng này arr() = range("A1: D5").value
Bây giờ em muốn ghi ra excel Ô E1 giá trị vùng số 4444 (Vùng D15 tương ứng trong bảng excel).
Em nghĩ nó sẽ thế này, nhưng excel báo lỗi. Em kính nhờ thầy và mọi người giúp em ạ.
Em cảm ơn .

View attachment 209326

Sub AA
Dim arr()
arr = range("A1:D5").value
range("E1").Resize(ubound(arr()), 1).value = arr(1 to ubound(arr()),4 to 4)
End sub

Chào bạn,

VBA chỉ cho phép truy suất phần tử của mảng chứ không cho truy suất cả dòng/cột nên code của bạn lỗi là đúng thôi. Bạn nên đọc để có kiến thức cơ bản chứ đừng nên viết theo những gì bạn nghĩ, lỗi thì hỏi. Học kiểu này thì lâu lắm.

Về tình huống mà bạn đưa ra có các cách giải quyết sau:
1. Đọc từng phần tử của mảng và ghi vào vị trí đặt kết quả trên sheet (Cách làm như bài #17)
2. Tận dụng các hàm trong WorksheetFunction, cụ thể là INDEX()

Range("E1").Resize(UBound(Arr())).Value = Application.WorksheetFunction.Index(Arr, 0, 4)

Cá nhân tôi không dùng cách này vì tôi rất hạn chế dùng WorksheetFunction trong VBA trừ những trường hợp bất đắc dĩ.
3. Trích xuất mảng con từ mảng lớn rồi mới ghi vào sheet. Ví dụ tôi viết 1 hàm trích xuất mảng như sau:

Function CutArray2D(ByVal Arr As Variant, ByVal LB1 As Long, ByVal UB1 As Long, ByVal LB2 As Long, ByVal UB2 As Long) As Variant
Dim ResultArr As Variant, i As Long, j As Long
ReDim ResultArr(LB1 To UB1, LB2 To UB2)
For i = LB1 To UB1
    For j = LB2 To UB2
        ResultArr(i, j) = Arr(i, j)
    Next
Next
CutArray2D = ResultArr
End Function

Sử dụng:

Range("E1").Resize(UBound(Arr())).Value = CutArray2D(Arr, 1, UBound(Arr, 1), 4, 4)

T/B:
Tôi không phải thầy bà gì cả nên đừng gọi thầy nhé.
Đừng gọi đích danh.