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

Liên hệ QC
viehoai

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,600
Được thích
2,907
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ị
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Tường_Vi đã viết:
PHP: 
 ReDim Arr(1 To UBound(sArray), 1 To UBound(sArray, 2))


Trong đoạn code trên tại sao mình không dùng là
1 to 2
mà phải là
1 To UBound(sArray, 2)


​
Nhấp chuột vào đây để mở rộng...
Giả sử lấy Range làm ví dụ minh họa và giả sử sArray = Range("gì gì đó").Value, khi ấy ta có:
- Tính theo chiều dọc: 1 là STT của phần tử đầu tiên và UBound(sArray, 1) là STT của phần tử cuối cùng (số 1 màu đỏ nghĩa là nói đến chiều thứ nhất)
- Tính theo chiều ngang: 1 là STT của phần tử đầu tiên và UBound(sArray, 2) là STT của phần tử cuối cùng (số 2 màu đỏ nghĩa là nói đến chiều thứ hai)
Giờ bạn muốn tạo 1 Array mới (biến tên là Arr) có kích thước bằng với sArray thì đương nhiên phải ReDim Arr(1 To UBound(sArray), 1 To UBound(sArray, 2)) ---> Đó là do bạn chưa biết trước phần tử cuối cùng có STT là bao nhiêu đâu mà ghi trực tiếp ---> Đương nhiên, nếu bạn biết chắc UBound(sArray, 2) = 2 (mảng Arr chắc chắn chỉ xài có 2 cột) thì cứ ghi thành ReDim Arr(1 To UBound(sArray), 1 To 2) cũng chẳng có vấn đề gì
(cái này gần giống với name động ấy)
 
Upvote 0
Bắt đầu học mảng từ đâu?

Em đang muốn học mảng nhưng không biết nên bắt đầu từ đâu?
Em đọc bài viết về Array nhưng (hình như cũng là người biết qua về Mảng rồi)
 
Upvote 0
Sorry, em post xong mấy thấy bài anh NDU
Em đã hiểu hơn rồi ạh
==========
 
Lần chỉnh sửa cuối:
Upvote 0
Tường_Vi đã viết:
Em đang muốn học mảng nhưng không biết nên bắt đầu từ đâu?
Em đọc bài viết về Array nhưng (hình như cũng là người biết qua về Mảng rồi)
Nhấp chuột vào đây để mở rộng...
Thì mảng cũng gần giống với Range thôi, khi bạn dùng vòng lập duyệt qua Range thế nào thì mảng cũng thế ấy
Vậy, để bắt đầu với mảng, hãy thường xuyên làm những bài tập xử lý range liên quan đến vòng lập là được rồi
Bạn cứ nghĩ ra bất cứ đề tài nào cho việc xử lý dữ liệu trên bảng tính rồi post lên đây, mọi người sẽ nghĩ cách chuyển chúng sang mảng giúp bạn ---> Từ những ví dụ cụ thế ấy, bạn sẽ tiếp thu rất dễ dàng
 
Upvote 0
Ví dụ 1 (Học mảng): dùng vòng lặp quét và gán giá trị từ mảng vào range
- Sheet1 từ A1: A10 có dữ liệu tăng dần (nhưng ko đều nhau)
ví dụ
A1: 1
A2: 2
A3: 2
A4: 3
A5: 4
A6: 5
A7: 6
A8: 6
A9: 6
A10: 10

E đang dùng vòng lặp này để duyệt

PHP: 
a = Sheet1.[A65000].End(xlUp).Row 

    If Sheet1.Cells(Sheet1.[A65000].End(xlUp).Row , 1) <> Sheet1.[A65000].End(xlUp).Row     Then

        For i = 1 To a

            Sheet1.Cells(i , 1) = i

        Next

Giờ em muốn dùng vòng lặp trong mảng nếu thấy sai thì gán vào trong range.

Xin Anh/Chị chỉ giúp
 
Upvote 0
Tường_Vi đã viết:
Ví dụ 1 (Học mảng): dùng vòng lặp quét và gán giá trị từ mảng vào range
- Sheet1 từ A1: A10 có dữ liệu tăng dần (nhưng ko đều nhau)
ví dụ
A1: 1
A2: 2
A3: 2
A4: 3
A5: 4
A6: 5
A7: 6
A8: 6
A9: 6
A10: 10

E đang dùng vòng lặp này để duyệt

PHP: 
a = Sheet1.[A65000].End(xlUp).Row 

    If Sheet1.Cells(Sheet1.[A65000].End(xlUp).Row , 1) <> Sheet1.[A65000].End(xlUp).Row     Then

        For i = 1 To a

            Sheet1.Cells(i , 1) = i

        Next

Giờ em muốn dùng vòng lặp trong mảng nếu thấy sai thì gán vào trong range.

Xin Anh/Chị chỉ giúp
Nhấp chuột vào đây để mở rộng...
Code chuyển sang mảng sẽ thế này
PHP: 
Sub Test()
  Dim Arr, i As Long
  With Sheet1
    Arr = .Range(.[A1], .[A65000].End(xlUp)).Value
    For i = 1 To UBound(Arr, 1)
      Arr(i, 1) = i
    Next
    .Range(.[A1], .[A65000].End(xlUp)).Value = Arr
  End With
End Sub
Hoặc vầy:
PHP: 
Sub Test()
  Dim Arr, i As Long
  With Sheet1
    Arr = .Range(.[A1], .[A65000].End(xlUp)).Value
    For i = 1 To UBound(Arr, 1)
      If Arr(i, 1) <> i Then Arr(i, 1) = i
    Next
    .Range(.[A1], .[A65000].End(xlUp)).Value = Arr
  End With
End Sub
- Đầu tiên gán mảng Arr bằng với vùng dữ liệu tại cột A (như vậy ta khỏi phải chỉnh lại kích thước của mảng) ---> Lưu ý rằng sau khi gán như vậy thì Arr sẽ là mảng 2 chiều với chiều thứ nhất có kích thước = số dòng của vùng dữ liệu, chiều thứ 2 có kích thước = 1 (tương đương với 1 cột dữ liệu)
- Duyệt toàn bộ mảng, gán lại STT
- Gán Arr kết quả xuống Range
 
Lần chỉnh sửa cuối:
Upvote 0
Ví dụ 2: Dùng dictionary & mảng để lọc duy nhất khi thỏa mãn một điều kiện
Dữ Liệu
Cột A ----Cột B-----Cột C
Tên ------Tiền------Kỳ
A1 -------10-------2011-11
A1 -------10-------2011-11
A1 -------10-------" "
A2 --------10--------2011-11
A2 --------10--------2011-12
A2 --------10--------

Xử lý: Chọn kỳ 2011-11
Kết Quả

Tên ------Tiền
A1 -------20
A2--------10
 

File đính kèm

  • test1.xls
    17 KB · Đọc: 126
Upvote 0
Tường_Vi đã viết:
Ví dụ 2: Dùng dictionary & mảng để lọc duy nhất khi thỏa mãn một điều kiện
Dữ Liệu
Cột A ----Cột B-----Cột C
Tên ------Tiền------Kỳ
A1 -------10-------2011-11
A1 -------10-------2011-11
A1 -------10-------" "
A2 --------10--------2011-11
A2 --------10--------2011-12
A2 --------10--------

Xử lý: Chọn kỳ 2011-11
Kết Quả

Tên ------Tiền
A1 -------20
A2--------10
Nhấp chuột vào đây để mở rộng...
Đúng ra bài này phải nên giải quyết bằng PivotTable (vì đó mới là công cụ phù hợp)
Còn nếu viết code VBA và viết ở mức tổng quát nhất e rằng sẽ rất dài dòng
Vậy tôi viết theo đúng dữ liệu trong file của bạn nhé (dùng sự kiện Change)
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$11" Then
    Dim sArray, Arr(), tmp1, tmp2
    Dim lR As Long, n As Long
    sArray = Range("A2:C10000").Value
    ReDim Arr(1 To UBound(sArray, 1), 1 To 2)
    Range("G13:H10000").ClearContents
    With CreateObject("Scripting.Dictionary")
      For lR = 1 To UBound(sArray, 1)
        If sArray(lR, 3) = Target.Value Then
          tmp1 = sArray(lR, 1): tmp2 = sArray(lR, 2)
          If Not .Exists(tmp1) Then
            n = n + 1
            .Add tmp1, n
            Arr(n, 1) = tmp1
            Arr(n, 2) = tmp2
          Else
            Arr(.Item(tmp1), 2) = Arr(.Item(tmp1), 2) + tmp2
          End If
        End If
      Next
    End With
    If n Then Range("G13").Resize(n, 2).Value = Arr
  End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Tường_Vi đã viết:
Ví dụ 2: Dùng dictionary & mảng để lọc duy nhất khi thỏa mãn một điều kiện
Dữ Liệu
Cột A ----Cột B-----Cột C
Tên ------Tiền------Kỳ
A1 -------10-------2011-11
A1 -------10-------2011-11
A1 -------10-------" "
A2 --------10--------2011-11
A2 --------10--------2011-12
A2 --------10--------

Xử lý: Chọn kỳ 2011-11
Kết Quả

Tên ------Tiền
A1 -------20
A2--------10
Nhấp chuột vào đây để mở rộng...

Làm như sau, lấy Hàm Filter2DArray của thầy ndu96081631,

Mã: 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
    Dim TmpArr, Arr, Dic, TmpStr, Tmp
    Dim i As Long, j As Long, Chk As Boolean, TmpVal As Double
    On Error Resume Next
    Set Dic = CreateObject("Scripting.Dictionary")
        TmpArr = sArray
        ColIndex = ColIndex + LBound(TmpArr, 2) - 1
        Chk = (InStr("><=", Left(FindStr, 1)) > 0)
    For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
        If Chk And FindStr <> "" Then
            TmpVal = CDbl(TmpArr(i, ColIndex))
            If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
        Else
            If Left(FindStr, 1) = "!" Then
                If Not (UCase(TmpArr(i, ColIndex)) Like UCase(Mid(FindStr, 2, Len(FindStr)))) Then Dic.Add i, ""
            Else
                If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
            End If
        End If
    Next
    If Dic.Count > 0 Then
        Tmp = Dic.Keys
        ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
            For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
                For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
                    Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), j)
                Next
            Next
        If HasTitle Then
            For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
                Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
            Next
        End If
    End If
    Filter2DArray = Arr
End Function


Sau đó biến ra:

Mã: 
Sub LocDuyNhat()
    Dim i As Long, iR As Long
    Dim sArray, Arr()
    Sheet1.Range("G13:H100").ClearContents
    sArray = Filter2DArray(Sheet1.Range("A2:C8").Value, 3, Sheet1.Range("F11").Value, False)
    ReDim Arr(1 To UBound(sArray, 1), 1 To 3)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(sArray, 1)
            If sArray(i, 1) <> vbNullString Then
                Tmp = sArray(i, 1) '<--- Day la cai can loc duy nhat
                If Not .Exists(Tmp) Then
                    iR = iR + 1
                    .Add Tmp, iR
                    Arr(iR, 1) = Tmp
                    Arr(iR, 2) = sArray(i, 2) '<--- Cot nay can cong don
                Else
                    Arr(.Item(Tmp), 2) = Arr(.Item(Tmp), 2) + sArray(i, 2)
                End If
            End If
        Next
    End With
    If iR Then Sheet1.Range("G13").Resize(iR, 2).Value = Arr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Đúng ra bài này phải nên giải quyết bằng PivotTable (vì đó mới là công cụ phù hợp)
Còn nếu viết code VBA và viết ở mức tổng quát nhất e rằng sẽ rất dài dòng
Vậy tôi viết theo đúng dữ liệu trong file của bạn nhé (dùng sự kiện Change)
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$11" Then
    Dim sArray, Arr(), tmp1, tmp2
    Dim lR As Long, n As Long
    sArray = Range("A2:C10000").Value
    ReDim Arr(1 To UBound(sArray, 1), 1 To 2)
    Range("G13:H10000").ClearContents
    With CreateObject("Scripting.Dictionary")
      For lR = 1 To UBound(sArray, 1)
        If sArray(lR, 3) = Target.Value Then
          tmp1 = sArray(lR, 1): tmp2 = sArray(lR, 2)
          If Not .Exists(tmp1) Then
            n = n + 1
            .Add tmp1, n
            Arr(n, 1) = tmp1
            Arr(n, 2) = tmp2
          Else
            Arr(.Item(tmp1), 2) = Arr(.Item(tmp1), 2) + tmp2
          End If
        End If
      Next
    End With
    If n Then Range("G13").Resize(n, 2).Value = Arr
  End If
End Sub
Nhấp chuột vào đây để mở rộng...

Hình như Code của Thầy chưa đúng với yêu cầu ạ! Phải lọc điều kiện ở cột C và lọc duy nhất ở cột A mới đúng ý của tác giả.
 

File đính kèm

  • Loc_LocDuyNhat.xls
    40.5 KB · Đọc: 102
Lần chỉnh sửa cuối:
Upvote 0
minhthien321 đã viết:
Hình như Code của Thầy chưa đúng với yêu cầu ạ! Phải lọc điều kiện ở cột C và lọc duy nhất ở cột A mới đúng ý của tác giả.
Nhấp chuột vào đây để mở rộng...
- Điều kiện cột C chính là chổ này: If sArray(lR, 3) = Target.Value Then
- Lọc duy nhất chính là chổ này: If Not .Exists(tmp1) Then
- Cộng dồn chính là chổ này: Arr(.Item(tmp1), 2) = Arr(.Item(tmp1), 2) + tmp2
Còn như kết quả không đúng thì: TÁC GIẢ VUI LÒNG XEM LẠI DỮ LIỆU CỘT C (không đồng nhất)
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
- Điều kiện cột C chính là chổ này: If sArray(lR, 3) = Target.Value Then
- Lọc duy nhất chính là chổ này: If Not .Exists(tmp1) Then
- Cộng dồn chính là chổ này: Arr(.Item(tmp1), 2) = Arr(.Item(tmp1), 2) + tmp2
Còn như kết quả không đúng thì: TÁC GIẢ VUI LÒNG XEM LẠI DỮ LIỆU CỘT C (không đồng nhất)
Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...

Thầy thử xem lại, em đã so sánh kỹ mới nói vậy ạ.
 

File đính kèm

  • Loc_LocDuyNhat.xls
    53.5 KB · Đọc: 62
Upvote 0
minhthien321 đã viết:
Thầy thử xem lại, em đã so sánh kỹ mới nói vậy ạ.
Nhấp chuột vào đây để mở rộng...
Tôi không thấy có điều gì không ổn cả!
Bạn cho ví dụ cụ thể xem trường hợp nào sẽ cho kết quả sai?
---------------------
minhthien lưu ý thêm rằng: Ở đây người ta HỎI ĐỂ TÌM HIỂU VỀ ARRAY VÀ DICTIONARY chứ không phải giải quyết 1 vấn đề cụ thể---> Nếu mà Filer2DArray thì đến khi nào người ta mới học được đây?
 
Lần chỉnh sửa cuối:
Upvote 0
concogia đã viết:
Minhthien cho mình hỏi cái hàm Filter2DArray có tác dụng gì trong code này vậy ???
Híc, sao cứ làm phức tạp thêm thế nhỉ
Híc híc
Nhấp chuột vào đây để mở rộng...

Hàm này để lọc lấy điều kiện là mã 201112, những mã khác bỏ qua. Sau đó mới lọc duy nhất ở cột A và cộng dồn ở cột B.

ndu96081631 đã viết:
Tôi không thấy có điều gì không ổn cả!
Bạn cho ví dụ cụ thể xem trường hợp nào sẽ cho kết quả sai?
---------------------
minhthien lưu ý thêm rằng: Ở đây người ta HỎI ĐỂ TÌM HIỂU VỀ ARRAY VÀ DICTIONARY chứ không phải giải quyết 1 vấn đề cụ thể---> Nếu mà Filer2DArray thì đến khi nào người ta mới học được đây?
Nhấp chuột vào đây để mở rộng...

Chính vì thế em mới đi tắt là mượn hàm của Thầy cho nhanh, tác giả chủ yếu hỏi lọc duy nhất và cộng dồn. Nếu em AutoFilter trước rồi copy qua vùng khác rồi mới dùng thủ tục lọc duy nhất ở vùng mới này thì cũng được.
 
Upvote 0
minhthien321 đã viết:
Hàm này để lọc lấy điều kiện là mã 201112, những mã khác bỏ qua. Sau đó mới lọc duy nhất ở cột A và cộng dồn ở cột B.



Chính vì thế em mới đi tắt là mượn hàm của Thầy cho nhanh, tác giả chủ yếu hỏi lọc duy nhất và cộng dồn. Nếu em AutoFilter trước rồi copy qua vùng khác rồi mới dùng thủ tục lọc duy nhất ở vùng mới này thì cũng được.
Nhấp chuột vào đây để mở rộng...
Trời ơi là Trời
Mã: 
.......
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 3).Value
        For I = 1 To UBound(Vung)
            If Vung(I, 3) = [f11].Value Then
                If Not d.exists(Vung(I, 1)) Then
                    d.Add Vung(I, 1), Vung(I, 2)
                Else
                    d.Item(Vung(I, 1)) = d.Item(Vung(I, 1)) + Vung(I, 2)
                End If
            End If
        Next I
...............
Chỉ cần dùng If Vung(I, 3) = [f11].Value Then đã loại được các mã không thỏa điều kiện rồi mà.
Híc
 
Upvote 0
minhthien321 đã viết:
Hình như Code của Thầy chưa đúng với yêu cầu ạ! Phải lọc điều kiện ở cột C và lọc duy nhất ở cột A mới đúng ý của tác giả.
Nhấp chuột vào đây để mở rộng...
Code của thầy ndu hoàn toàn đúng với yêu cầu. Vấn đề ở chỗ định dạng dữ liệu ở cột C không đồng nhất. Chỉ cần chỉnh 1 tí trong code là có thể khắc phục tình trạng này:
Mã: 
If [B]CStr[/B](sArray(lR, 3)) = Target.Value Then
 
Upvote 0
ndu96081631 đã viết:
Tôi không thấy có điều gì không ổn cả!
Bạn cho ví dụ cụ thể xem trường hợp nào sẽ cho kết quả sai?
---------------------
minhthien lưu ý thêm rằng: Ở đây người ta HỎI ĐỂ TÌM HIỂU VỀ ARRAY VÀ DICTIONARY chứ không phải giải quyết 1 vấn đề cụ thể---> Nếu mà Filer2DArray thì đến khi nào người ta mới học được đây?
Nhấp chuột vào đây để mở rộng...

Đúng là dữ liệu kỳ chưa đồng nhất... ẹc
Cám ơn các Anh
Em sẽ nghiên cứu ví dụ và hỏi những chỗ chưa hiểu

Cám ơn Anh
 
Upvote 0
concogia đã viết:
Trời ơi là Trời
Mã: 
.......
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 3).Value
        For I = 1 To UBound(Vung)
            If Vung(I, 3) = [f11].Value Then
                If Not d.exists(Vung(I, 1)) Then
                    d.Add Vung(I, 1), Vung(I, 2)
                Else
                    d.Item(Vung(I, 1)) = d.Item(Vung(I, 1)) + Vung(I, 2)
                End If
            End If
        Next I
...............
Chỉ cần dùng If Vung(I, 3) = [f11].Value Then đã loại được các mã không thỏa điều kiện rồi mà.
Híc
Nhấp chuột vào đây để mở rộng...



tintam7251 đã viết:
Code của thầy ndu hoàn toàn đúng với yêu cầu. Vấn đề ở chỗ định dạng dữ liệu ở cột C không đồng nhất. Chỉ cần chỉnh 1 tí trong code là có thể khắc phục tình trạng này:
Mã: 
If [B]CStr[/B](sArray(lR, 3)) = Target.Value Then
Nhấp chuột vào đây để mở rộng...

Hihihi, dữ liệu và cấu trúc của người ta để vậy nên làm vậy, chứ thay đổi sao được! Tuy nhiên, có như vậy mới vừa được trả lời và vừa được học hỏi thêm phải không các Thầy!
 
Upvote 0
Về đoạn code này
PHP: 
ReDim Arr(1 To UBound(sArray, 1), 1 To 2)

Có phải là sau khi chế biến, vùng đích chỉ còn 2 cột và số dòng bị co lại mình phải redim
và Mảng mới Arr có
Số dòng mới tương đương là 1 To UBound(sArray, 1) và
Số cột mới là 1 To 2
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
  • Question
Xin giúp chọn nhiểu phần tử của drop list cùng 1 lúc
Trả lời
2
Đọc
55
huhumalu
H
N
Tổng hợp phiếu lấy ý kiến của GV, NV trong trường học
Trả lời
2
Đọc
55
tigertiger
tigertiger
hung2412
Cần giải đáp: Sau khi Auto Fit dòng thì dòng nó không tự co lại
Trả lời
2
Đọc
124
senna
senna
V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
6
Đọc
158
Phuocam
Phuocam
D
Định dạng trong excel làm nghiệm thu đường
2
Trả lời
29
Đọc
13K
HieuCD
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom