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
PHP: 
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error GoTo Err
If Target.Address = "$B$1" Then
        Dim dg As Long
        Dim sh As Worksheet
        Dim d As Object, Arr(), sArr, lRow As Long, lR As Long, item
        Set d = CreateObject("Scripting.Dictionary")
        Sheet5.Range("A5:T65000").ClearContents
       
For I = 1 To 3
        With sh(I)
        
     
            dg = sh.[A99000].End(xlUp).Row
            sArr = .Range("A5:AA" & dg).Value
            ReDim Arr(1 To UBound(sArr, 1), 1 To 4)
            
           
            For lRow = 1 To UBound(sArr, 1)
                If sArr(lRow, 27) = Target.Value And sArr(lRow, 7) <> "KLV" Then
                
                    item = sArr(lRow, 8) & " " & sArr(lRow, 13)
                    If Not d.Exists(item) Then
                        lR = lR + 1
                        d.Add item, lR
                        KQ = Split(item, " ", 2)
                        Arr(lR, 1) = KQ(0)
                        Arr(lR, 3) = KQ(1)
                        Arr(lR, 4) = -(sArr(lRow, 12))
                        Else
                        Arr(d.item(item), 4) = (Arr(d.item(item), 4) - sArr(lRow, 12))
                    End If
                 End If
               
             Next lRow
                
             Sheet5.Range("A5").Resize(lR, 4).Value = Arr
          End With
 
    
Next
End If

Err:
End Sub
Ví dụ 4: duyệt qua nhiều sheet, dùng mảng & Dic, Split để lọc duy nhất về sheet 5 khi thỏa mãn điều kiện nào đó

Tổng hợp dữ liệu Sheet IMP, EXP, NKX vào sheet F-C-R report (sheet 5).
(...em lỡ đặt tên sheet 4 là sheet tổng hợp...nên sửa lại)

code hiện tại báo lỗi tại with sh(I). Em loay hoay mãi chưa được ạh
 

File đính kèm

  • duyet sheet .zip
    62.3 KB · Đọc: 76
Lần chỉnh sửa cuối:
Upvote 0
Tường_Vi đã viết:
Ví dụ 4: duyệt qua nhiều sheet, dùng mảng & Dic, Split để lọc duy nhất về sheet 5 khi thỏa mãn điều kiện nào đó
Tổng hợp dữ liệu Sheet IMP, EXP, NKX vào sheet F-C-R report (sheet 5).
(...em lỡ đặt tên sheet 4 là sheet tổng hợp...nên sửa lại)

code hiện tại báo lỗi tại with sh(I). Em loay hoay mãi chưa được ạh
Nhấp chuột vào đây để mở rộng...
Bạn nghiên cứu đoạn code này nhen
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$1" Then
        
        Dim Arr(), sArr, lRow As Long, lR As Long, item, sh As Worksheet, KQ
        Sheet5.Range("A5:D65000").ClearContents
        With CreateObject("Scripting.Dictionary")
        
        For Each sh In Worksheets
            If sh.Name <> "TONGHOP" Then
        
                sArr = sh.Range(sh.[A5], sh.[A65536].End(xlUp)).Resize(, 27).Value
                
                     For lRow = 1 To UBound(sArr, 1)
                        If sArr(lRow, 27) = Target.Value Then
                            item = sArr(lRow, 8) & " " & sArr(lRow, 13)
                          
                                If Not .Exists(item) Then
                                     lR = lR + 1
                                    .Add item, lR
                                    
                                    KQ = Split(item, " ", 2)
                                    ReDim Preserve Arr(1 To UBound(sArr, 1) * 2, 1 To 4)
                                    Arr(lR, 1) = KQ(0)
                                    Arr(lR, 3) = KQ(1)
                                    Arr(lR, 4) = sArr(lRow, 12)
                                Else
                                    Arr(.item(item), 4) = Arr(.item(item), 4) + sArr(lRow, 12)
                                End If
                        End If
                      Next lRow
                End If
               
            Next sh
           
        End With
        Sheet5.Range("A5").Resize(lR, 4).Value = Arr
  End If
 
End Sub
 

File đính kèm

  • Hoc_Array (split) .xls
    72.5 KB · Đọc: 114
Upvote 0
Cám ơn Anh Hùng rất nhiều
Như vậy em nghĩ mãi không ra

Những sheet khác không cùng cấu trúc em có thể đặt tên là Tổng họp 1 , 2, 3...v..v rồi dùng left duyệt

Em hiểu rồi
 
Upvote 0
TV_câu hỏi 5: Dùng mảng để so sánh dữ liệu giữa 2 sheet, những dữ liệu chưa có đem qua sheet thứ 3

Ví dụ 5:
- Sheet1: từ A1:A10 có dữ liệu là Test01, Test02...., Test10
- Sheet2: Từ A1:A5 có dữ liệu là Test06,Test06, Test07,Test08,Test09

Dùng mảng để so sánh
- Dem từng phần từ trong mảng Sheet1 so sánh với sheet2
- PHần từ nào chưa có --> đem qua Sheet3

Như vậy có 06 phần từ sau sẽ được bê qua sheet3 (Test01,Test02,Test03,Test04,Test05,Test10)

Em định ghép mảng và dùng Dic để làm nhưng khó quá
 
Upvote 0
Hãy làm bằng những thao tác căn bản nhất về mảng:
Xác định các vùng dữ liệu
Tạo các mảng chứa dữ liệu
Xác định (bằng cách suy luận, phỏng đoán) kích thước mảng kết quả, ReDim mảng kết quả.
Dùng vòng lặp duyệt qua mảng này, xét điều kiện (có hoặc không có liên quan đến mảng kia), nếu thoả gán vào mảng kết quả
gán mảng kết quả xuống sheet.

Nói chung, sử dụng mảng chỉ loanh quanh mấy bước trên thôi.

Còn suy luận thế nào, dùng thuật toán nào, ăn thua cái đầu. Bây giờ bài nào cũng chỉ, cũng làm mẫu, mà không tự nghĩ, thì chả bao giờ tự làm được.

Bài này so với bài 136 còn dễ hơn nhiều, nhưng 136 làm được, bài này không? tại sao?
 
Lần chỉnh sửa cuối:
Upvote 0
Tường_Vi đã viết:
TV_câu hỏi 5: Dùng mảng để so sánh dữ liệu giữa 2 sheet, những dữ liệu chưa có đem qua sheet thứ 3

Ví dụ 5:
- Sheet1: từ A1:A10 có dữ liệu là Test01, Test02...., Test10
- Sheet2: Từ A1:A5 có dữ liệu là Test06,Test06, Test07,Test08,Test09

Dùng mảng để so sánh
- Dem từng phần từ trong mảng Sheet1 so sánh với sheet2
- PHần từ nào chưa có --> đem qua Sheet3

Như vậy có 06 phần từ sau sẽ được bê qua sheet3 (Test01,Test02,Test03,Test04,Test05,Test10)

Em định ghép mảng và dùng Dic để làm nhưng khó quá
Nhấp chuột vào đây để mở rộng...
- Dễ nhất là dùng Advanced Filter
- Nếu muốn học về mảng, xem bài này:
http://www.giaiphapexcel.com/forum/showthread.php?48469-Tạo-hàm-so-sánh-2-danh-sách&
Trong mảng, cứ nói đén việc tìm kiếm, xác định sự tồn tại của 1 phần tử trong 1 danh sách hoặc lọc duy nhất, hãy nghĩ đến Dictionary
 
Upvote 0
Xin giải thích giúp em đoạn code này
PHP: 
ReDim Preserve Arr(1 To UBound(SArr, 1) * 2, 1 To 10)
 
Upvote 0
đoạn code trên sao lại phải có đoạn *2 ạh?
UBound(SArr, 1) * 2​
 
Upvote 0
Tường_Vi đã viết:
đoạn code trên sao lại phải có đoạn *2 ạh?
UBound(SArr, 1) * 2​
Nhấp chuột vào đây để mở rộng...
Người ta muốn mở rộng kích thước của mảng Arr với chiều thứ nhất gấp đôi chiêu thứ nhất của SArr ---> Quét qua 2 sheet, nếu không nhân 2 thế hóa ra kích thước của Arr bị thiếu làm sao?
Ví dụ:
- Chiều thứ nhất của SArr là 10
- Vậy chiều thứ nhất của Arr là 20
Thế thôi
 
Lần chỉnh sửa cuối:
Upvote 0
Trường hợp số sheet qua là 3 thì sẽ là
UBound(SArr,1) *3​


Phải không Anh?

​
 
Upvote 0
PHP: 
Option Base 1

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False
 'On Error GoTo Err
  If Target.Address = "$B$1" And Target.Value = "" Then
        
        Dim Arr(), SArr, lRow As Long, lR As Long, item, sh As Worksheet, KQ
        Sheet5.Range("A5:T65000").ClearContents
        With CreateObject("Scripting.Dictionary")
        
        For Each sh In Worksheets
            If Left(sh.Name, 2) <> "RP" Then
        
                SArr = sh.Range(sh.[A5], sh.[A65536].End(xlUp)).Resize(, 25).Value
                
                     For lRow = 1 To UBound(SArr, 1)
                        If SArr(lRow, 21) = Target Then ' column 21 la cot ky FCR
                            item = SArr(lRow, 8) & " " & SArr(lRow, 13)
                                If Not .Exists(item) Then
                                     lR = lR + 1
                                    .Add item, lR
                                    
                                    KQ = Split(item, " ", 2)
                                    ReDim Preserve Arr(1 To UBound(SArr, 1) * 3, 1 To 13)
                                    Arr(lR, 1) = SArr(lRow, 6) ' ngay HD
                                    Arr(lR, 2) = KQ(0)  ' van don
                                    Arr(lR, 3) = SArr(lRow, 7) ' head
                                    Arr(lR, 4) = SArr(lRow, 9) ' cty
                                    Arr(lR, 5) = SArr(lRow, 10) ' tax code
                                    Arr(lR, 6) = SArr(lRow, 11) ' Dien giai
                                    Arr(lR, 7) = SArr(lRow, 2) ' so hoa don
                                    Arr(lR, 8) = KQ(1)  ' ngoai te
                                    Arr(lR, 9) = SArr(lRow, 12) ' truoc thue
                                    Arr(lR, 10) = SArr(lRow, 16) ' thue
                                    Arr(lR, 11) = SArr(lRow, 17) ' sau thue
                                    Arr(lR, 12) = SArr(lRow, 14) ' ty gia
                                    Arr(lR, 13) = SArr(lRow, 23) ' remark OSF
                                Else
                                    Arr(.item(item), 9) = (Arr(.item(item), 9) + SArr(lRow, 12))
                                    Arr(.item(item), 10) = (Arr(.item(item), 10) + SArr(lRow, 16))
                                    Arr(.item(item), 11) = (Arr(.item(item), 11) + SArr(lRow, 17))
                                End If
                        End If
                      Next lRow
                End If
               
            Next sh
           
        End With
        Sheet6.Range("A5").Resize(lR, 13).Value = Arr
        
        
    
End If
  
  
'Err:
Application.ScreenUpdating = True
End Sub



Private Sub Worksheet_Deactivate()
  Sheet6.Range("A5:M20000").ClearContents
End Sub
Đoạn code trên em test thành công với trường hợp target ""Nhưng khi sửa lại là target = "" thì nó báo lỗi dòng ReDim Anh ạhAnh xem giúp em với
 

File đính kèm

  • test.zip
    218.9 KB · Đọc: 45
Lần chỉnh sửa cuối:
Upvote 0
Tường_Vi đã viết:
PHP: 
Đoạn code trên em test thành công với trường hợp target  ""Nhưng khi sửa lại là target = "" thì nó báo lỗi dòng ReDim Anh ạhAnh xem giúp em với[/QUOTE]
Hỏi lại:
- Bạn muốn làm điều gì trong file này?
- Ở sheet RP-TongHop tôi thấy bạn ghi "[B]nhập X tại ô B1 để update OSF[/B]" ---> Vậy khi nhập x vào B1, ta sẽ tìm "cái gì" ở các sheet? ---> Vì thấy trong code có đoạn[B] If SArr(lRow, 21) = Target Then[/B], chẳng ăn nhập gì với chữ "x" cả
-[B] ReDim Preserve[/B] chỉ có thể thay đổi được kích thước của chiều cuối cùng, trong khi bạn lại để đoạn code [B]ReDim Preserve[/B] trong vòng lập và muốn thay đổi chiều thứ nhất, vậy đâu có được
- Trong code có đoạn [B]Sheet5.Range("A5:T65000").ClearContents[/B] mà trong file bạn chẳng có sheet nào là Sheet5 cả
- Cuối code là đoạn [B]Sheet6.Range("A5").Resize(lR, 13).Value = Arr [/B]---> Nếu không tìm thấy gì thì lR sẽ = 0 và đoạn code này chắc chắn báo lỗi, lý ra phải là [B]If lR Then Sheet6.Range("A5").Resize(lR, 13).Value = Arr[/B]
Hic... sai nhiều quá
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
Mảng thật tuyệt vời nhưng học và sử dụng nó không đơn giản chút nào
Em mới phát hiện ra lỗi là do khi duyệt qua các sheet nhưng số dòng không giống nhau nên nó bị lỗi dòng ReDim

- Bạn muốn làm điều gì trong file này?

1. Duyệt qua các sheet nếu left(tên sheet,2) <> "RP" (tương đương với sheet1,2,3)
2. Nếu thỏa mãn cells(i,21) (là Cột U - kỳ FC.R) nếu là trông "" thì sau khi mình sẽ update vào sheet tổng hợp


 
Upvote 0
Em làm được rổi nhé
Cám ơn các anh nhiều
 
Upvote 0
Dạo này vợ đòi bỏ, rỗi thời gian sang nghiên cứu món Excel, VBA thấy hay quá, sau khi viết code thì nó không chạy, không biết sai ở đâu

Sub Chanqua()
Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long
Dongdau = 3
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
For i = Dongdau To Dongcuoi
Thang(i, 1) = DL(i, 1)
Next i
Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub

Ai biết xin chỉ giúp tôi với.
 
Upvote 0
trungvdb đã viết:
Dạo này vợ đòi bỏ, rỗi thời gian sang nghiên cứu món Excel, VBA thấy hay quá, sau khi viết code thì nó không chạy, không biết sai ở đâu

Sub Chanqua()
Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long
Dongdau = 3
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
For i = Dongdau To Dongcuoi
Thang(i, 1) = DL(i, 1)
Next i
Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub

Ai biết xin chỉ giúp tôi với.
Nhấp chuột vào đây để mở rộng...
Bạn đang lẫn lộn giữa chỉ số dòng trên bảng tính và chỉ số "dòng" trong mảng
Chỉ số dòng trên bảng tính với Dongdau bắt đầu từ 3
Chỉ số "dòng" trong mảng bắt đầu từ 1
Vậy làm sao mà gán đây
Có thể sửa lại tí:
Mã: 
Sub Chanqua()
  Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long, [COLOR=#ff0000]n As Long[/COLOR]
  Dongdau = 3
  Dongcuoi = [A65000].End(xlUp).Row
  DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
  Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
  For i = Dongdau To Dongcuoi
    [COLOR=#ff0000]n = n + 1[/COLOR]
    Thang(n, 1) = DL(n, 1)
  Next i
  Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub
Chổ màu đỏ là chổ được thêm vào
Còn nếu là tôi thì tôi viết khác
PHP: 
Sub Chanqua()
  Dim DL, Thang, i As Long
  With Range([A3], [A65536].End(xlUp))
    DL = .Value
    ReDim Thang(1 To UBound(DL, 1), 1 To 1)
    For i = 1 To UBound(DL, 1)
      Thang(i, 1) = DL(i, 1)
    Next i
    .Offset(, 1).Value = Thang
  End With
End Sub
 
Upvote 0
ndu96081631 đã viết:
Bạn đang lẫn lộn giữa chỉ số dòng trên bảng tính và chỉ số "dòng" trong mảng
Chỉ số dòng trên bảng tính với Dongdau bắt đầu từ 3
Chỉ số "dòng" trong mảng bắt đầu từ 1
Vậy làm sao mà gán đây
Có thể sửa lại tí:
Mã: 
Sub Chanqua()
  Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long, [COLOR=#ff0000]n As Long[/COLOR]
  Dongdau = 3
  Dongcuoi = [A65000].End(xlUp).Row
  DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
  Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
  For i = Dongdau To Dongcuoi
    [COLOR=#ff0000]n = n + 1[/COLOR]
    Thang(n, 1) = DL(n, 1)
  Next i
  Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub
Chổ màu đỏ là chổ được thêm vào
Còn nếu là tôi thì tôi viết khác
PHP: 
Sub Chanqua()
  Dim DL, Thang, i As Long
  With Range([A3], [A65536].End(xlUp))
    DL = .Value
    ReDim Thang(1 To UBound(DL, 1), 1 To 1)
    For i = 1 To UBound(DL, 1)
      Thang(i, 1) = DL(i, 1)
    Next i
    .Offset(, 1).Value = Thang
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

Trong trường hợp này n không nhất thiết phải khai báo giới hạn của nó chạy từ bao nhiêu đến bao nhiêu ?

ở đoạn Code thứ 2 màu xanh ReDim Thang(1 To UBound(DL, 1), 1 To 1) tôi chưa hiểu lắm về nó có nghĩa là vậy?
 
Lần chỉnh sửa cuối:
Upvote 0
trungvdb đã viết:
Trong trường hợp này n không nhất thiết phải khai báo giới hạn của nó chạy từ bao nhiêu đến bao nhiêu ?

ở đoạn Code thứ 2 màu xanh ReDim Thang(1 To UBound(DL, 1), 1 To 1) tôi chưa hiểu lắm về nó có nghĩa là vậy?
Nhấp chuột vào đây để mở rộng...
n đương nhiên chạy từ 1 đến khi nào hết vòng lập thì ngưng
ReDim Thang... chẳng qua để chỉnh lại kích thước của mảng Thang sao cho nó bằng với DL (gần giống với Resize ấy)
 
Upvote 0
ndu96081631 đã viết:
n đương nhiên chạy từ 1 đến khi nào hết vòng lập thì ngưng
ReDim Thang... chẳng qua để chỉnh lại kích thước của mảng Thang sao cho nó bằng với DL (gần giống với Resize ấy)
Nhấp chuột vào đây để mở rộng...

Từ code của bác, tôi thắc mắc liệu cách dùng trong bài giải của bác có gì khác nếu viết thành thế này không?

Sub Chanqua()
Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long
Dongdau = 3
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
For i = Dongdau To UBound(DL, 1)
Thang(i, 1) = DL(i, 1)
Next i
Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub
 
Upvote 0
trungvdb đã viết:
Từ code của bác, tôi thắc mắc liệu cách dùng trong bài giải của bác có gì khác nếu viết thành thế này không?

Sub Chanqua()
Dim DL, Thang, Dongdau As Long, Dongcuoi As Long, i As Long
Dongdau = 3
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A" & (Dongdau) & ":A" & Dongcuoi).Value
Thang = Range("B" & (Dongdau) & ":B" & Dongcuoi).Value
For i = Dongdau To UBound(DL, 1)
Thang(i, 1) = DL(i, 1)
Next i
Range("B" & (Dongdau) & ":B" & Dongcuoi).Value = Thang
End Sub
Nhấp chuột vào đây để mở rộng...
Mấu chốt bài này sai là
Dongdau=3, nếu = 1 thì OK.
Tại vì for i= dongdau to dongcuoi
Mà dongdau=3 => dongcuoi=dongdau-3
Nếu dongcuoi=dongcuoi thì mảng DL kg hiểu DL(dongcuoi) trong khi nó chỉ có dongcuoi - 3 dòng.
 
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

L
Tạo hàm Round cho nhiều dòng
Trả lời
13
Đọc
6K
ptm0412
ptm0412
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
60
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
59
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
127
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
161
Phuocam
Phuocam
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