Xóa phần tử rỗng trong mảng arr ?

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Chào anh chị!
Em đang học VBA, học bóc tác dữ liệu từ Sheet TraCuu sang Sheet CONGNO theo từng Ngày đặt hàng, một ngày tương ứng em gán dữ liệu vào mảng arr để đưa vào sheet CONGNO.

Đây là sheet TraCuu:

1578795792416.png

Em muốn nó xuất ra sheet CONGNO theo mẫu như thế này:

1578795847489.png

Nghĩa là dữ liệu đi theo từng ngày, nhưng vấn đề là khi em đưa dữ liệu từng ngày vào mảng để dán ra sheet CONGNO thì có những phần tử có giá trị rỗng nên khi dán ra nó dư dòng trống nên kết quả không mong muốn, như này:

1578797630828.png

Vày đây là code của em:

Mã:
Option Explicit

Sub CONGNO()
    'Call TraCuuKH
    Dim ShTraCuu As Worksheet
    Dim ShCongNo As Worksheet
    Dim dic As Scripting.Dictionary
    Set ShTraCuu = ThisWorkbook.Sheets("TraCuu")
    Set ShCongNo = ThisWorkbook.Sheets("CONGNO")
    Set dic = New Scripting.Dictionary
     

    Dim i As Long, lrTraCuu As Long, a As Long, b As Long
    Dim k As Long, RowDate As Long, j As Long, SoDongDuLieu As Long
    Dim dArr(), sArr(), arr()
    Dim TieuDe As Range
    Set TieuDe = ShCongNo.Range("P1:V1")
    RowDate = 26
    lrTraCuu = ShTraCuu.Range("E1000000").End(xlUp).Row
    dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value
    ReDim sArr(1 To UBound(dArr()), 1 To 1)
   
       
    For i = 1 To UBound(dArr(), 1)
        If Not dic.Exists(dArr(i, 20)) Then
            a = a + 1
            dic.Add dArr(i, 20), a
        End If
    Next i
    sArr() = WorksheetFunction.Transpose(dic.Keys)
    For k = 1 To UBound(sArr())
        ShCongNo.Cells(RowDate, 11) = CDate(sArr(k, 1))
        TieuDe.Copy ShCongNo.Range("E" & RowDate + 1)
         ReDim arr(1 To UBound(dArr()), 1 To 7)
            For j = 1 To UBound(arr())
                If ShCongNo.Range("K" & RowDate) = dArr(j, 20) Then
                    b = b + 1
                    arr(b, 1) = b
                    arr(b, 2) = dArr(j, 2)
                    arr(b, 3) = dArr(j, 3)
                    arr(b, 4) = dArr(j, 4)
                    arr(b, 5) = dArr(j, 6)
                    arr(b, 6) = dArr(j, 7)
                    arr(b, 7) = dArr(j, 8)
                End If
            Next j
            ShCongNo.Range("E" & RowDate + 2).Resize(UBound(arr()), 7) = arr
            SoDongDuLieu = WorksheetFunction.CountIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11).Value)
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 2) = ShCongNo.Range("TONGCONG").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 2) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("THANHTIEN_TRACUU"))
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 3) = ShCongNo.Range("CHIETKHAU").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 3) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CHIETKHAU_TRACUU"))
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 4) = ShCongNo.Range("CONLAI").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 4) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CONLAI_TRACUU"))
             RowDate = RowDate + SoDongDuLieu + 6
            Erase arr
    Next k
    
End Sub
Cho em hỏi là sau khi gán dữ liệu vào mảng arr rồi, có cách nào xóa đi những phần tử có giá trị rỗng ko, để lúc dán ra nó ko dư các dòng trống! Hoặc anh chị có cách nào thì chỉ giúp em với.

Xin cảm ơn anh chị đã giúp đỡ!
Em có gửi file đính kèm ạ!
 

File đính kèm

Lần chỉnh sửa cuối:

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,708
Được thích
9,050
Điểm
560
Định nghĩa: mảng là một nhóm dữ liệu được xếp liên tục trong bộ nhớ.
Lưu ý từ khoá "liên tục" ở trên.

Dùng mảng để làm vịệc với dữ liệu không liên tục là ngang nhiên đi tréo que với nguyên tắc mảng.
Cách để loại những chỗ đứt đoạn thì có nhưng nó không giản dị như filter trên bảng tính.

Chú: tôi chỉ giải thích cho các bạn nào có ý đồ tương tự chứ không cốt ý giải quyết vấn đề cho thớt.
 

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
9,023
Được thích
10,435
Điểm
1,560
1*
học VBA
--------

Dim dArr(), sArr(), arr()
Dim TieuDe As Range
Set TieuDe = ShCongNo.Range("P1:V1")
RowDate = 26
Set ShTraCuu = ThisWorkbook.Sheets("TraCuu")
Set ShCongNo = ThisWorkbook.Sheets("CONGNO")

lrTraCuu = ShTraCuu.Range("E1000000").End(xlUp).Row
Chỉnh lại:
PHP:
const ten_tra_cuu as string = "TraCuu"
const ten_cong_no as string = "CONGNO"
const rng_tieu_de as string  = "P1:V1"
const row_date as long = 26
const last_cell as long = "E1000000"

Dim dArr() as variant , sArr() as variant , arr() as variant
Dim TieuDe As Range
Set TieuDe = ShCongNo.Range(rng_tieu_de)
Set ShTraCuu = ThisWorkbook.Sheets(ten_tra_cuu)
Set ShCongNo = ThisWorkbook.Sheets(ten_cong_no)
lrTraCuu = ShTraCuu.Range(last_cell).End(xlUp).Row
2*
Dữ liệu DateTime
dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value
nên chuyển thành
PHP:
dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value2
có vài lý do, trong đó có 1 lý do xem ở bài này:

3*
ShCongNo.Range("E" & RowDate + 2).Resize(UBound(arr()), 7) = arr
sửa lại: số lượng kết quả không thừa, không thiếu, vừa xinh chính là giá trị của biến b, viết rõ thuộc tính nào của Range.
PHP:
ShCongNo.Range("E" & RowDate + 2).Resize(b, 7).value = arr
4*
SoDongDuLieu = WorksheetFunction.CountIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11).Value)
ShCongNo.Range("H" & RowDate + SoDongDuLieu + 2) = ShCongNo.Range("TONGCONG").Value
ShCongNo.Range("K" & RowDate + SoDongDuLieu + 2) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("THANHTIEN_TRACUU"))
ShCongNo.Range("H" & RowDate + SoDongDuLieu + 3) = ShCongNo.Range("CHIETKHAU").Value
ShCongNo.Range("K" & RowDate + SoDongDuLieu + 3) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CHIETKHAU_TRACUU"))
ShCongNo.Range("H" & RowDate + SoDongDuLieu + 4) = ShCongNo.Range("CONLAI").Value
ShCongNo.Range("K" & RowDate + SoDongDuLieu + 4) = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CONLAI_TRACUU"))
- Cần viết rõ thuộc tính nào của Range (vế bên trái)
- Gọi lại nhiều lần một đối tượng thì có thể dùng cấu trúc With ... End With
- Giá trị "NgayDatHang_TraCuu" khai báo Const lên đầu sub.
 

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Cảm ơn anh @befaint đã hướng dẫn một số cách tối ưu code! Em đã tìm ra vấn đề!!
Vấn đề ở chỗ phải cho b = 0 vào mỗi vòng lặp. Code đúng đã chạy được nè :D

Mã:
Option Explicit

Sub CONGNO()
    'Call TraCuuKH
    Const ten_tra_cuu As String = "TraCuu"
    Const ten_cong_no As String = "CONGNO"
    Const rng_tieu_de As String = "P1:V1"
    Const row_date As Long = 26
    Const last_cell As String = "E1000000"
    
    Dim ShTraCuu As Worksheet
    Dim ShCongNo As Worksheet
    Dim dic As Scripting.Dictionary
    Dim dArr() As Variant, sArr() As Variant, arr() As Variant
    Dim TieuDe As Range
    Dim lrTraCuu As Long
    
    Set dic = New Scripting.Dictionary
    Set ShTraCuu = ThisWorkbook.Sheets(ten_tra_cuu)
    Set ShCongNo = ThisWorkbook.Sheets(ten_cong_no)
    Set TieuDe = ShCongNo.Range(rng_tieu_de)
    lrTraCuu = ShTraCuu.Range(last_cell).End(xlUp).Row

    Dim i As Long, a As Long, b As Long
    Dim k As Long, RowDate As Long, j As Long, SoDongDuLieu As Long
    RowDate = 26
    ShCongNo.Range("E26:K52").ClearContents
    dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value2
    ReDim sArr(1 To UBound(dArr()), 1 To 1)
      
    For i = 1 To UBound(dArr(), 1)
        If Not dic.Exists(dArr(i, 20)) Then
            a = a + 1
            dic.Add dArr(i, 20), a
        End If
    Next i
    sArr() = WorksheetFunction.Transpose(dic.Keys)
    For k = 1 To UBound(sArr())
        b = 0
        ShCongNo.Cells(RowDate, 11) = CDate(sArr(k, 1))
        TieuDe.Copy ShCongNo.Range("E" & RowDate + 1)
         ReDim arr(1 To UBound(dArr()), 1 To 7)
            For j = 1 To UBound(arr())
                If ShCongNo.Range("K" & RowDate) = dArr(j, 20) Then
                    b = b + 1
                    arr(b, 1) = b
                    arr(b, 2) = dArr(j, 2)
                    arr(b, 3) = dArr(j, 3)
                    arr(b, 4) = dArr(j, 4)
                    arr(b, 5) = dArr(j, 6)
                    arr(b, 6) = dArr(j, 7)
                    arr(b, 7) = dArr(j, 8)
                End If
            Next j
            ShCongNo.Range("E" & RowDate + 2).Resize(b, 7).Value = arr
            SoDongDuLieu = WorksheetFunction.CountIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11).Value)
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 2).Value = ShCongNo.Range("TONGCONG").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 2).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("THANHTIEN_TRACUU"))
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 3).Value = ShCongNo.Range("CHIETKHAU").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 3).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CHIETKHAU_TRACUU"))
            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 4).Value = ShCongNo.Range("CONLAI").Value
            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 4).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CONLAI_TRACUU"))
            RowDate = RowDate + SoDongDuLieu + 6
            Erase arr
    Next k
    
End Sub
 

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Anh @befaint cho em hỏi, code còn 1 lỗi, đó là với arr có 1 phần tử thì nó báo lỗi Out of range, còn 2 phần tử trở lên thì ko bị báo lỗi, anh em sai chỗ nào giúp em với ạ!

1578902197121.png

Code em:
Mã:
Option Explicit

Sub CONGNO()
    Call TraCuuKH
    Const ten_tra_cuu As String = "TraCuu"
    Const ten_cong_no As String = "CONGNO"
    Const rng_tieu_de As String = "P1:V1"
    Const row_date As Long = 26
    Const last_cell As String = "E1000000"
    
    Dim ShTraCuu As Worksheet
    Dim ShCongNo As Worksheet
    Dim dic As Scripting.Dictionary
    Dim dArr() As Variant, sArr() As Variant, arr() As Variant
    Dim TieuDe As Range
    Dim lrTraCuu As Long
    
    Set dic = New Scripting.Dictionary
    Set ShTraCuu = ThisWorkbook.Sheets(ten_tra_cuu)
    Set ShCongNo = ThisWorkbook.Sheets(ten_cong_no)
    Set TieuDe = ShCongNo.Range(rng_tieu_de)
    lrTraCuu = ShTraCuu.Range(last_cell).End(xlUp).Row
    ShCongNo.Range("E26:K65000").ClearContents
    If lrTraCuu <= 8 Then
        MsgBox "Khong Co Du Lieu", vbInformation
        Exit Sub
    End If

    Dim i As Long, a As Long, b As Long
    Dim k As Long, RowDate As Long, j As Long, SoDongDuLieu As Long
    RowDate = 26
    
    dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value
    ReDim sArr(1 To UBound(dArr()), 1 To 1)
      
    For i = 1 To UBound(dArr(), 1)
        If Not dic.Exists(dArr(i, 20)) Then
            a = a + 1
            dic.Add dArr(i, 20), a
        End If
    Next i
    If dic.Count = 0 Then Exit Sub
    sArr() = WorksheetFunction.Transpose(dic.Keys)
    For k = 1 To UBound(sArr())
        b = 0
        ShCongNo.Cells(RowDate, 11) = CDate(sArr(k, 1))
        ShCongNo.Cells(RowDate, 10) = ShCongNo.Range("Ngay_TraCuu")
        
        TieuDe.Copy
        ShCongNo.Range("E" & RowDate + 1).PasteSpecial xlPasteValues
         ReDim arr(1 To UBound(dArr()), 1 To 7)
            For j = 1 To UBound(arr())
                If ShCongNo.Range("K" & RowDate) = dArr(j, 20) Then
                    b = b + 1
                    arr(b, 1) = b
                    arr(b, 2) = dArr(j, 2)
                    arr(b, 3) = dArr(j, 3)
                    arr(b, 4) = dArr(j, 4)
                    arr(b, 5) = dArr(j, 6)
                    arr(b, 6) = dArr(j, 7)
                    arr(b, 7) = dArr(j, 8)
                End If
            Next j
            ShCongNo.Range("E" & RowDate + 2).Resize(b, 7).Value = arr
            SoDongDuLieu = WorksheetFunction.CountIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11).Value)
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 2).Value = ShCongNo.Range("TONGCONG").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 2).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("THANHTIEN_TRACUU"))
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 3).Value = ShCongNo.Range("CHIETKHAU").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 3).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CHIETKHAU_TRACUU"))
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 4).Value = ShCongNo.Range("CONLAI").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 4).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CONLAI_TRACUU"))
            RowDate = RowDate + SoDongDuLieu + 3
            Erase arr
    Next k
    
End Sub
Em cảm ơn.
 

File đính kèm

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
9,023
Được thích
10,435
Điểm
1,560
Bỏ dòng này:
ReDim sArr(1 To UBound(dArr()), 1 To 1)

Thay:
sArr() = WorksheetFunction.Transpose(dic.Keys)

bằng:
If dic.count = 1 then
redim sArr(1 to 1, 1 to 1)
sArr(1,1)=dic.Keys
else
sArr = WorksheetFunction.Transpose(dic.Keys)
end if

------------
UBound(dArr())
Gọi rõ ràng lấy chỉ số trên của chiều nào UBound(dArr,1). Bỏ 2 cái dấu đóng mở ngoặc đi.

Đọc thêm bài này:
 

batman1

Thành viên gắn bó
Tham gia ngày
8 Tháng chín 2014
Bài viết
2,712
Được thích
4,036
Điểm
560
Tôi thấy code không bắt sArr phải là mảng 2 chiều, vậy thì đơn giản như bài #8 thôi.
 

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Sau khi em sửa xong thì nó báo lỗi Type mis match!!
1578907300832.png

code:
Mã:
Option Explicit

Sub CONGNO()
    Call TraCuuKH
    Const ten_tra_cuu As String = "TraCuu"
    Const ten_cong_no As String = "CONGNO"
    Const rng_tieu_de As String = "P1:V1"
    Const row_date As Long = 26
    Const last_cell As String = "E1000000"
    
    Dim ShTraCuu As Worksheet
    Dim ShCongNo As Worksheet
    Dim dic As Scripting.Dictionary
    Dim dArr() As Variant, sArr() As Variant, arr() As Variant
    Dim TieuDe As Range
    Dim lrTraCuu As Long
    
    Set dic = New Scripting.Dictionary
    Set ShTraCuu = ThisWorkbook.Sheets(ten_tra_cuu)
    Set ShCongNo = ThisWorkbook.Sheets(ten_cong_no)
    Set TieuDe = ShCongNo.Range(rng_tieu_de)
    lrTraCuu = ShTraCuu.Range(last_cell).End(xlUp).Row
    ShCongNo.Range("E26:K65000").ClearContents
    If lrTraCuu <= 8 Then
        MsgBox "Khong Co Du Lieu", vbInformation
        Exit Sub
    End If

    Dim i As Long, a As Long, b As Long
    Dim k As Long, RowDate As Long, j As Long, SoDongDuLieu As Long
    RowDate = 26
    
    dArr = ShTraCuu.Range("C9:AI" & lrTraCuu).Value
    
      
    For i = 1 To UBound(dArr, 1)
        If Not dic.Exists(dArr(i, 20)) Then
            a = a + 1
            dic.Add dArr(i, 20), a
        End If
    Next i
    If dic.Count = 0 Then Exit Sub
    If dic.Count = 1 Then
        ReDim sArr(1 To 1, 1 To 1)
        sArr(1, 1) = dic.Keys
        Else
        sArr = WorksheetFunction.Transpose(dic.Keys)
    End If
    For k = 1 To UBound(sArr, 1)
        b = 0
        ShCongNo.Cells(RowDate, 11) = CDate(sArr(k, 1))
        ShCongNo.Cells(RowDate, 10) = ShCongNo.Range("Ngay_TraCuu")
        
        TieuDe.Copy
        ShCongNo.Range("E" & RowDate + 1).PasteSpecial xlPasteValues
         ReDim arr(1 To UBound(dArr, 1), 1 To 7)
            For j = 1 To UBound(arr, 1)
                If ShCongNo.Range("K" & RowDate) = dArr(j, 20) Then
                    b = b + 1
                    arr(b, 1) = b
                    arr(b, 2) = dArr(j, 2)
                    arr(b, 3) = dArr(j, 3)
                    arr(b, 4) = dArr(j, 4)
                    arr(b, 5) = dArr(j, 6)
                    arr(b, 6) = dArr(j, 7)
                    arr(b, 7) = dArr(j, 8)
                End If
            Next j
            ShCongNo.Range("E" & RowDate + 2).Resize(b, 7).Value = arr
            SoDongDuLieu = WorksheetFunction.CountIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11).Value)
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 2).Value = ShCongNo.Range("TONGCONG").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 2).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("THANHTIEN_TRACUU"))
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 3).Value = ShCongNo.Range("CHIETKHAU").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 3).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CHIETKHAU_TRACUU"))
'            ShCongNo.Range("H" & RowDate + SoDongDuLieu + 4).Value = ShCongNo.Range("CONLAI").Value
'            ShCongNo.Range("K" & RowDate + SoDongDuLieu + 4).Value = WorksheetFunction.SumIf(ShTraCuu.Range("NgayDatHang_TraCuu"), ShCongNo.Cells(RowDate, 11), ShTraCuu.Range("CONLAI_TRACUU"))
            RowDate = RowDate + SoDongDuLieu + 3
            Erase arr
    Next k
    
End Sub
Anh @befaint có thể giải thích dùm em tại sao lúc arr có 1 phần tử thì nó báo lỗi ko ạ?
EM cảm ơn!
Bài đã được tự động gộp:

Tôi thấy code không bắt sArr phải là mảng 2 chiều, vậy thì đơn giản như bài #8 thôi.
Mình đã thử cách này nhưng vẫn báo lỗi Out of range ạ!
 

batman1

Thành viên gắn bó
Tham gia ngày
8 Tháng chín 2014
Bài viết
2,712
Được thích
4,036
Điểm
560
Mình đã thử cách này nhưng vẫn báo lỗi Out of range ạ!
Mã:
Sub test()
Dim dic As Object, sArr(), k As Long
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Add "hic hic", 0
'    dic.Add "he he", 0
'    dic.Add "blala", 0
    sArr = dic.keys
    For k = LBound(sArr) To UBound(sArr)
        Debug.Print sArr(k)
    Next k
End Sub
Nên nhớ là sArr(k) chứ không phải sArr(k, 1)
 

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Mã:
Sub test()
Dim dic As Object, sArr(), k As Long
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Add "hic hic", 0
'    dic.Add "he he", 0
'    dic.Add "blala", 0
    sArr = dic.keys
    For k = LBound(sArr) To UBound(sArr)
        Debug.Print sArr(k)
    Next k
End Sub
Nên nhớ là sArr(k) chứ không phải sArr(k, 1)
mình làm theo cách này thì đúng là rất ok, cảm ơn bạn @batman1 rất nhiều!!
 

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
9,023
Được thích
10,435
Điểm
1,560
giải thích dùm em tại sao lúc arr có 1 phần tử thì nó báo lỗi ko ạ?
Hôm nay mới có thời gian đọc bài của bạn.
1/
dic.Keys
Trả về một mảng một chiều gồm toàn bộ Keys tồn tại trong Dic.
Mảng một chiều này luôn có cận dưới bằng 0, dù khai báo Option Base 1
2/
Hàm Transpose() chuyển mảng 1 chiều thành mảng 2 chiều.
Nhưng: Khi mảng 1 chiều chỉ có 1 phần tử thì kết quả của hàm Transpose(array1D) vẫn là mảng 1 chiều. Gọi tới phần tử của mảng 1 chiều: array(chỉ_số);
mà bạn lại gọi sArr(k, 1) , truyền vào 2 chỉ số => lỗi.

3/
Với trường hợp của bạn chỉ cần gọi tới các keys thì có thể dùng cách này.
- Bỏ các dòng liên quan tới biến sArr
- Thêm
Dim item_key as variant

For k = 1 To UBound(sArr())
Thay bằng:
For each item_key in dic.Keys
ShCongNo.Cells(RowDate, 11).value = CDate(item_key)
'....
Next item_key
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,708
Được thích
9,050
Điểm
560
Rốt cuộc thì các đáp án có giải quyết vấn đề "xoá phần tử rỗng trong mảng..." như tiêu đề nêu ra hay không?
Tôi thì có cảm tưởng là chúng dùng một giải thuật khác để tránh mảng rỗng.
 

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ
Tham gia ngày
16 Tháng một 2010
Bài viết
130
Được thích
20
Điểm
670
Tuổi
31
Rốt cuộc thì các đáp án có giải quyết vấn đề "xoá phần tử rỗng trong mảng..." như tiêu đề nêu ra hay không?
Tôi thì có cảm tưởng là chúng dùng một giải thuật khác để tránh mảng rỗng.
Đúng rồi, tránh mảng rỗng sẽ ok hơn là làm cho nó có rỗng rồi xóa.
Tuy topic này chưa nói xóa mảng rỗng nhưng nó đã giải quyết được vấn đề của em!
Xin cảm ơn anh @VetMini , anh @befaint và anh @batman1 đã hỗ trợ em!
 
Top Bottom