Vấn đề sắp xếp hàng trong mảng (1 người xem)

Hoàng Trọng Nghĩa · 6/1/12

Tôi có 1 thủ tục lọc hàng có điều kiện trong mảng:

Mã:

Private Sub CommandButton1_Click()
    Dim MyArr1, MyArr2, MyItem As Long, MyRow As Long
        LocKhachHang.[A:I].ClearContents
        MyArr1 = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
        MyRow = UBound(MyArr1, 1)
        ReDim MyArr2(1 To MyRow, 1 To 9)
            [COLOR=#006400]'Giữ tiêu đề ở hàng đầu tiên:[/COLOR]
            MyArr2(1, 1) = MyArr1(1, 1)
            MyArr2(1, 2) = MyArr1(1, 2)
            MyArr2(1, 3) = MyArr1(1, 4)
            MyArr2(1, 4) = MyArr1(1, 5)
            MyArr2(1, 5) = MyArr1(1, 6)
            MyArr2(1, 6) = MyArr1(1, 11)
            MyArr2(1, 7) = MyArr1(1, 8)
            MyArr2(1, 8) = MyArr1(1, 9)
            MyArr2(1, 9) = MyArr1(1, 10)
    For MyItem = 2 To MyRow - 1
       [COLOR=#006400] 'Chuyển dữ liệu từ dưới lên trên:[/COLOR]
        If MyArr1(MyRow + 1 - MyItem, 1) <> "" And MyArr1(MyRow + 1 - MyItem, 15) <> "Thanh Lý" Then
            MyArr2(MyItem, 1) = MyArr1(MyRow + 1 - MyItem, 1)
            MyArr2(MyItem, 2) = MyArr1(MyRow + 1 - MyItem, 2)
            MyArr2(MyItem, 3) = MyArr1(MyRow + 1 - MyItem, 4)
            MyArr2(MyItem, 4) = MyArr1(MyRow + 1 - MyItem, 5)
            MyArr2(MyItem, 5) = MyArr1(MyRow + 1 - MyItem, 6)
            MyArr2(MyItem, 6) = MyArr1(MyRow + 1 - MyItem, 11)
            MyArr2(MyItem, 7) = MyArr1(MyRow + 1 - MyItem, 8)
            MyArr2(MyItem, 8) = MyArr1(MyRow + 1 - MyItem, 9)
            MyArr2(MyItem, 9) = MyArr1(MyRow + 1 - MyItem, 10)
        End If
    Next
    If IsArray(MyArr2) Then LocKhachHang.[A1].Resize(UBound(MyArr2, 1), 9).Value = MyArr2
End Sub

Xin vui lòng cho hỏi các vấn đề sau:

1) Sau khi chạy thủ tục, tại sheet LOC_KH có bị trống 1 số hàng (màu vàng) do lọc theo điều kiện, Vậy làm sao để nó dồn lên trên để không bị trống nữa?

2) Code có thể rút gọn được không?

Xin cám ơn rất nhiều!

concogia · 6/1/12

minhthien321 đã viết:

Tôi có 1 thủ tục lọc hàng có điều kiện trong mảng:

Mã:

Private Sub CommandButton1_Click()
    Dim MyArr1, MyArr2, MyItem As Long, MyRow As Long
        LocKhachHang.[A:I].ClearContents
        MyArr1 = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
        MyRow = UBound(MyArr1, 1)
        ReDim MyArr2(1 To MyRow, 1 To 9)
            [COLOR=#006400]'Giữ tiêu đề ở hàng đầu tiên:[/COLOR]
            MyArr2(1, 1) = MyArr1(1, 1)
            MyArr2(1, 2) = MyArr1(1, 2)
            MyArr2(1, 3) = MyArr1(1, 4)
            MyArr2(1, 4) = MyArr1(1, 5)
            MyArr2(1, 5) = MyArr1(1, 6)
            MyArr2(1, 6) = MyArr1(1, 11)
            MyArr2(1, 7) = MyArr1(1, 8)
            MyArr2(1, 8) = MyArr1(1, 9)
            MyArr2(1, 9) = MyArr1(1, 10)
    For MyItem = 2 To MyRow - 1
       [COLOR=#006400]'Chuyển dữ liệu từ dưới lên trên:[/COLOR]
        If MyArr1(MyRow + 1 - MyItem, 1) <> "" And MyArr1(MyRow + 1 - MyItem, 15) <> "Thanh Lý" Then
            MyArr2(MyItem, 1) = MyArr1(MyRow + 1 - MyItem, 1)
            MyArr2(MyItem, 2) = MyArr1(MyRow + 1 - MyItem, 2)
            MyArr2(MyItem, 3) = MyArr1(MyRow + 1 - MyItem, 4)
            MyArr2(MyItem, 4) = MyArr1(MyRow + 1 - MyItem, 5)
            MyArr2(MyItem, 5) = MyArr1(MyRow + 1 - MyItem, 6)
            MyArr2(MyItem, 6) = MyArr1(MyRow + 1 - MyItem, 11)
            MyArr2(MyItem, 7) = MyArr1(MyRow + 1 - MyItem, 8)
            MyArr2(MyItem, 8) = MyArr1(MyRow + 1 - MyItem, 9)
            MyArr2(MyItem, 9) = MyArr1(MyRow + 1 - MyItem, 10)
        End If
    Next
    If IsArray(MyArr2) Then LocKhachHang.[A1].Resize(UBound(MyArr2, 1), 9).Value = MyArr2
End Sub

Xin vui lòng cho hỏi các vấn đề sau:

1) Sau khi chạy thủ tục, tại sheet LOC_KH có bị trống 1 số hàng (màu vàng) do lọc theo điều kiện, Vậy làm sao để nó dồn lên trên để không bị trống nữa?

2) Code có thể rút gọn được không?

Xin cám ơn rất nhiều!

- Thêm 1 biến K, khi nào thỏa lấy biến K làm thứ tự của mảng kết quả
- Lấy từ dưới lên thì cứ cho biến chạy từ .....dưới lên, khai báo chi "dzắc dzối" quá
Chạy thử code này:

Mã:

Public Sub RacRoi()
Dim Vung, Mg(), I, K
        LocKhachHang.[A:I].ClearContents: K = 1
        Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
        ReDim Mg(1 To UBound(Vung), 1 To 9)
            'Giu tieu de o hang dau tien:
            Mg(1, 1) = Vung(1, 1)
            Mg(1, 2) = Vung(1, 2)
            Mg(1, 3) = Vung(1, 4)
            Mg(1, 4) = Vung(1, 5)
            Mg(1, 5) = Vung(1, 6)
            Mg(1, 6) = Vung(1, 11)
            Mg(1, 7) = Vung(1, 8)
            Mg(1, 8) = Vung(1, 9)
            Mg(1, 9) = Vung(1, 10)
    For I = UBound(Vung) To 2 Step -1
        'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
        If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
          K = K + 1
            Mg(K, 1) = Vung(I, 1)
            Mg(K, 2) = Vung(I, 2)
            Mg(K, 3) = Vung(I, 4)
            Mg(K, 4) = Vung(I, 5)
            Mg(K, 5) = Vung(I, 6)
            Mg(K, 6) = Vung(I, 11)
            Mg(K, 7) = Vung(I, 8)
            Mg(K, 8) = Vung(I, 9)
            Mg(K, 9) = Vung(I, 10)
        End If
    Next
    LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg
End Sub

Mình không biết cách rút gọn nữa
Híc

Hoàng Trọng Nghĩa · 6/1/12

concogia đã viết:
- Thêm 1 biến K, khi nào thỏa lấy biến K làm thứ tự của mảng kết quả
- Lấy từ dưới lên thì cứ cho biến chạy từ .....dưới lên, khai báo chi "dzắc dzối" quá
Chạy thử code này:

Mã:

[SIZE=3][COLOR=#ff0000][B]Public Sub RacRoi[/B][/COLOR][/SIZE]() ..........................................

Mình không biết cách rút gọn nữa
Híc

Kakaka, đúng là trả lời kiểu CÒ! Trời ơi, tại không chịu suy nghĩ nè! Cám ơn bác concogia nhiều nhé!

ptm0412 · 6/1/12

Thử cái này để rút gọn xem, chỉ rút gọn code, không nói gì đến thuật toán:

PHP:

Sub RacRoi() 
Dim Vung, Mg(), I, K
         LocKhachHang.[A:I].ClearContents: K = 1
         Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
         ReDim Mg(1 To UBound(Vung), 1 To 9)
        List1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
        List2 = Array(1, 2, 4, 5, 6, 11, 8, 9, 10)
        For i = 1 to 9
             Mg(1, List1(i)) = Vung(1, List2(i))
        Next
    For I = UBound(Vung) To 2 Step -1
         'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
         If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
           K = K + 1
           For j = 1 to 9
             Mg(K, List1(j)) = Vung(I, List2(j))
          Next
         End If
     Next     
LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg 
End Sub

Hoàng Trọng Nghĩa · 6/1/12

ptm0412 đã viết:

Thử cái này để rút gọn xem, chỉ rút gọn code, không nói gì đến thuật toán:

PHP:

Sub RacRoi() 
Dim Vung, Mg(), I, K
         LocKhachHang.[A:I].ClearContents: K = 1
         Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
         ReDim Mg(1 To UBound(Vung), 1 To 9)
        List1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
        List2 = Array(1, 2, 4, 5, 6, 11, 8, 9, 10)
        For i = 1 to 9
             Mg(1, List1(i)) = Vung(1, List2(i))
        Next
    For I = UBound(Vung) To 2 Step -1
         'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
         If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
           K = K + 1
           For j = 1 to 9
             Mg(K, List1(j)) = Vung(I, List2(j))
          Next
         End If
     Next     
LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg 
End Sub

Cách này của Sư phụ "ngộ" thiệt! Nhưng em thử chạy nó báo lỗi số 9 (Supscript out of range). Vì cách này quá mới mẽ nên chưa thể biết sai điểm nào, mong Sư phụ chỉ dạy!

ptm0412 · 6/1/12

quên, mảng tự đặt thì bắt đầu bằng 0
Sửa
For i = 1 to 9
thành
For i = 0 to 8
là được.

Ở dưới là j nha, vì sợ trùng với I của Cò

Hoàng Trọng Nghĩa · 6/1/12

Cám ơn các Sư phụ, các Thầy rất nhiều!

Thử đem so sánh gán trên sheet với gán trên ListView, tại bài này:

http://www.giaiphapexcel.com/forum/showthread.php?59888-Array-Listview-t%E1%BB%91c-%C4%91%E1%BB%99-kinh-ho%C3%A0ng-%28-4s-v%E1%BB%9Bi-65500-d%C3%B2ng-%29!!!&p=370741#post370741

thì em thấy hình như ListView nó tự điều chỉnh dòng trống hay sao đó mà không cần phải thêm K vào, không biết tại sao!

concogia · 6/1/12

ptm0412 đã viết:

Thử cái này để rút gọn xem, chỉ rút gọn code, không nói gì đến thuật toán:

PHP:

Sub RacRoi() 
Dim Vung, Mg(), I, K
         LocKhachHang.[A:I].ClearContents: K = 1
         Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
         ReDim Mg(1 To UBound(Vung), 1 To 9)
        List1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
        List2 = Array(1, 2, 4, 5, 6, 11, 8, 9, 10)
        For i = 1 to 9
             Mg(1, List1(i)) = Vung(1, List2(i))
        Next
    For I = UBound(Vung) To 2 Step -1
         'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
         If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
           K = K + 1
           For j = 1 to 9
             Mg(K, List1(j)) = Vung(I, List2(j))
          Next
         End If
     Next     
LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg 
End Sub

Híc. Xách xe đi nhậu mới nghĩ ra cách rút gọn code, gọi cho Minh Thiện gợi ý cách làm. Bi giờ về mở máy thấy Lão Chít Tiệt làm chứ hổng phải Minh Thiện. Ngộ
Híc, chắc lúc mình gọi cho Minh Thiện sóng di động thế quái nào gọi luôn cho Lão í nên Lão làm đúng như cái mình gợi ý cho Minh Thiện.
Ủa, mà cái thằng List1 làm cái quái gì nhỉ ?????. Ngộ quá ta
Híc

ptm0412 · 6/1/12

concogia đã viết:
Híc. Xách xe đi nhậu mới nghĩ ra cách rút gọn code, gọi cho Minh Thiện gợi ý cách làm. Bi giờ về mở máy thấy Lão Chít Tiệt làm chứ hổng phải Minh Thiện. Ngộ
Híc, chắc lúc mình gọi cho Minh Thiện sóng di động thế quái nào gọi luôn cho Lão í nên Lão làm đúng như cái mình gợi ý cho Minh Thiện.
Ủa, mà cái thằng List1 làm cái quái gì nhỉ ?????. Ngộ quá ta
Híc

Hic kí rì mà hic! Thiên tài không cần ai gợi ý. Còn cái vụ List1 hả? Phòng xa sau này ai đó làm List1 lộn tùng phèo giống List2, chứ thiên tài dư biết chỉ cần thế này:

PHP:

For i = 0 to 8
    Mg(1, i + 1) = Vung(1, List2(i))
Next

SA_DQ · 7/1/12

Ếch Xanh cho hỏi ké cái nha, thông cảm đi nà!

Ta có thể áp dụng fương thức tìm kiếm để tìm thành fần nào trong mảng chứa trị cụ thể nào đó cần tìm không ta?

nmhung49 · 7/1/12

concogia đã viết:
- Thêm 1 biến K, khi nào thỏa lấy biến K làm thứ tự của mảng kết quả
- Lấy từ dưới lên thì cứ cho biến chạy từ .....dưới lên, khai báo chi "dzắc dzối" quá
Chạy thử code này:

Mã:

Public Sub RacRoi() Mg(1, 1) = Vung(1, 1) Mg(1, 2) = Vung(1, 2) Mg(1, 3) = Vung(1, 4) Mg(1, 4) = Vung(1, 5) Mg(1, 5) = Vung(1, 6) Mg(1, 6) = Vung(1, 11) Mg(1, 7) = Vung(1, 8) Mg(1, 8) = Vung(1, 9) Mg(1, 9) = Vung(1, 10) End Sub

Em nghĩ nếu thay đoạn này băng đoạn này thì tốt độ cũng không thay đổi nhiêu, còn nếu muốn sài trên mảng thì làm trực tiếp trên sheet CSDL khổi qua sheet Loc_KH làm chi cho khoe

PHP:

KhachHang.Range("B5:C5,E5:K5").Copy LocKhachHang.Range("a1")

Lê Duy Thương · 7/1/12

minhthien321 đã viết:
Tôi có 1 thủ tục lọc hàng có điều kiện trong mảng:

Xin vui lòng cho hỏi các vấn đề sau:

1) Sau khi chạy thủ tục, tại sheet LOC_KH có bị trống 1 số hàng (màu vàng) do lọc theo điều kiện, Vậy làm sao để nó dồn lên trên để không bị trống nữa?

2) Code có thể rút gọn được không?

Xin cám ơn rất nhiều!

tôi không hiểu code nhiều lắm nhưng với code của minhthien321 mà chạy trên excel 2007--trở lên thì chỉ cần sửa đoạn này là tạm ổn

PHP:

If IsArray(MyArr2) Then LocKhachHang.[A2].Resize(UBound(MyArr2, 1), 9).Value = MyArr2
     Sheets("loc_kh").Range("A1:I" & [a60000].End(3).Row() + 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6,  7, 8, 9), Header:=xlNo

sealand · 7/1/12

Mình thấy làm như anh em thì lại đẻ ra 2 cái List phiền thêm. Mục đích chỉ để đảo vị trí của cột 7.
Y kiến mình nên làm thế này gọn gàng hơn:

Mã:

Sub RacRoi()
Dim Vung, Mg(), I, K
         LocKhachHang.[A:I].ClearContents: K = 1
         Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
         ReDim Mg(1 To UBound(Vung), 1 To 9)
        For I = 1 To 9
             Mg(1, I) = Vung(1, I)
        Next
    For I = UBound(Vung) To 2 Step -1
         'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
         If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
           K = K + 1
           For j = 1 To 9
             Mg(K, j) = Vung(I, j + IIf(j = 7, 3, 0))
          Next
         End If
     Next
LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg
End Sub

ptm0412 · 7/1/12

sealand đã viết:
Mình thấy làm như anh em thì lại đẻ ra 2 cái List phiền thêm. Mục đích chỉ để đảo vị trí của cột 7.
Y kiến mình nên làm thế này gọn gàng hơn:

Code mình viết dùng 2 cái List1 và List2 là trường hợp tổng quát. List1 có thể bỏ vì ít khi đảo lộn, nhưng cái List2 đâu phải lúc nào cũng cộng 3 hoặc không cộng. Tất nhiên là tuỳ từng bài cụ thể để viết, nhưng có 1 cách tổng quát vẫn hơn.

sealand · 7/1/12

Đấy là trường hợp thay đổi ít, để tổng quát thì em thay hàm choose vào là được thôi mà

Mã:

Sub RacRoi()
Dim Vung, Mg(), I, K
         LocKhachHang.[A:I].ClearContents: K = 1
         Vung = KhachHang.Range("B5", KhachHang.[B65536].End(xlUp)).Resize(, 15).Value
         ReDim Mg(1 To UBound(Vung), 1 To 9)
        For I = 1 To 9
             Mg(1, I) = Vung(1, I)
        Next
    For I = UBound(Vung) To 2 Step -1
         'Chuyen du lieu tu duoi len tren (moi o tren cu o duoi):
         If Vung(I, 1) <> "" And Vung(I, 15) <> "Thanh Lý" Then
           K = K + 1
           For j = 1 To 9
             Mg(K, j) = Vung(I, Choose(j, 1, 2, 3, 4, 5, 6, 11, 8, 9, 10))
          Next
         End If
     Next
LocKhachHang.[A1].Resize(UBound(Mg), 9).Value = Mg
End Sub

Hoàng Trọng Nghĩa · 9/1/12

SA_DQ đã viết:
Ta có thể áp dụng fương thức tìm kiếm để tìm thành fần nào trong mảng chứa trị cụ thể nào đó cần tìm không ta?

Em nghĩ là được, viết hàm dưới đây, Bác SA có thể kiểm chứng:

PHP:

Function FindString(ByVal MyArray, MyString As String) As Boolean
    Dim MyTmp(), iRow As Long, iCol As Long
    On Error Resume Next
    MyTmp = MyArray
    FindString = False
    For iRow = 1 To UBound(MyTmp, 1)
        For iCol = 1 To UBound(MyTmp, 2)
            If MyTmp(iRow, iCol) = MyString Then
                FindString = True
                Exit For
            End If
        Next
    Next
End Function

Kiểm tra:

PHP:

Sub test()
    Dim MyArr
    MyArr = [A1:C5].Value
    MsgBox FindString(MyArr, "Sa_DQ")
End Sub

sealand · 9/1/12

Không được Minh Thien ơi, Bác Sa hỏi về phương thức Find cơ mà. Trong khi phương thức Find chỉ áp dụng cho Range Object. Còn ví dụ của Minh Thien là sử dụng Hàm UDF trong hàm không sử dụng Find.

Hoàng Trọng Nghĩa · 9/1/12

Sau khi loại bỏ hàng rỗng từ mảng cũ sang mảng mới, vậy tại sao Ubound(NewArray) vẫn bằng Ubound(OldArray)?

Vậy có cách nào để điều chỉnh cho đúng với số hàng đã loại bỏ khoảng trắng không?

PHP:

Sub MangQuaRacRoi()
    Dim Vung(), Mg(), i As Long, j As Long, K As Long
    [F:G].ClearContents: K = 0
    Vung = Range([A1], [A65536].End(xlUp)).Resize(, 2).Value
    ReDim Mg(1 To UBound(Vung), 1 To 2)
    For i = 1 To UBound(Vung)
        If Vung(i, 2) <> "" Then
            K = K + 1
            For j = 1 To 2
                Mg(K, j) = Vung(i, j)
            Next
        End If
    Next
    MsgBox UBound(Mg, 1)
    [F1].Resize(UBound(Mg, 1), 2).Value = Mg
End Sub

ptm0412 · 9/1/12

Cách giải quyết:

PHP:

[F1].Resize(K, 2).Value = Mg

Mg đã redim từ đầu bằng vung, nếu không redim lần 2 thì có thay đổi kích thước gì đâu.

Hoàng Trọng Nghĩa · 9/1/12

ptm0412 đã viết:
Cách giải quyết:

PHP:

[F1].Resize(K, 2).Value = Mg

Mg đã redim từ đầu bằng vung, nếu không redim lần 2 thì có thay đổi kích thước gì đâu.

Dạ, cám ơn Sư phụ, nhưng chủ yếu em hỏi mình có thể RESIZE ngay tại cái mảng mới được không ạ? Bởi nếu mình gán lên Combobox thì khoảng trắng vẫn hiển thị trong List của nó.

ptm0412 · 9/1/12

Vụ này GPE cũng nói nhiều rồi:
ReDim Array sau khi đã có dữ liệu , thì mất dữ liệu
ReDim Preserve có thể bảo toàn dữ liệu, nhưng chỉ cho thay đổi kích thước chiều cuối cùng

Cách giải quyết cũng đã có, nhiều bài viết đã áp dụng:
Khai báo mảng xoay ngang, chiều 1 thành 2, 2 thành 1. Dòng thành cột cột thành dòng. Cụ thể là thay vì

ReDim Mg(1 To UBound(Vung), 1 To 2)

thì không khai báo trước kích thước Mg. Trước tiên xét điều kiện.
Khi thoả điều kiện, K = K +1, ReDimPreserve Mg(1 to 2, 1 to K)
Sau đó gán giá trị vào cột K (thay vì dòng K như cũ)

Cuối cùng, transpose Mg để gán xuống sheet, hoặc gán vào cái gì tuỳ ý.

Vụ xoay bảng này cũng có những ý kiến khuyến cáo không nên dùng:

- xoay bảng, rồi ngồi suy luận gán cái gì vào dòng nào cột nào của Array, tay xoay xoay, đầu nghiêng nghiêng, dễ bị tưởng là điên (ẹc ẹc)
- Suy luận sai, tìm không ra chỗ sai, dễ bị tẩu hoả nhập ma
- Transpose cũng có giới hạn của nó, nhiều cột quá không transpose được.
- Tốc độ chậm

concogia · 9/1/12

minhthien321 đã viết:
Sau khi loại bỏ hàng rỗng từ mảng cũ sang mảng mới, vậy tại sao Ubound(NewArray) vẫn bằng Ubound(OldArray)?

Vậy có cách nào để điều chỉnh cho đúng với số hàng đã loại bỏ khoảng trắng không?

PHP:

Sub MangQuaRacRoi() Dim Vung(), Mg(), i As Long, j As Long, K As Long [F:G].ClearContents: K = 0 Vung = Range([A1], [A65536].End(xlUp)).Resize(, 2).Value ReDim Mg(1 To UBound(Vung), 1 To 2) For i = 1 To UBound(Vung) If Vung(i, 2) <> "" Then K = K + 1 For j = 1 To 2 Mg(K, j) = Vung(i, j) Next End If Next MsgBox UBound(Mg, 1) [F1].Resize(UBound(Mg, 1), 2).Value = Mg End Sub

Sử dụng như cách của Thầy Ptm quả là "Phức Văn Tạp". Theo mình, cứ cho nó thêm một vòng lặp nữa là tìm được chính xác số dòng thôi mà, vòng For chạy trong mảng nhanh lắm, không lo về tốc độ đâu:

Mã:

Sub MangDechRacRoi()
    Dim Vung(), Mg(), i As Long, j As Long, K As Long, M As Long
    [F:G].ClearContents: K = 0
    Vung = Range([A1], [A65536].End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(Vung)
        If Vung(i, 2) <> "" Then M = M + 1
    Next i
        ReDim Mg(1 To M, 1 To 2)
        For i = 1 To UBound(Vung)
            If Vung(i, 2) <> "" Then
                K = K + 1
                For j = 1 To 2
                    Mg(K, j) = Vung(i, j)
                Next
            End If
        Next
    MsgBox UBound(Mg, 1)
    [F1].Resize(UBound(Mg, 1), 2).Value = Mg
End Sub

Hihi
Một cách khác nếu không muốn thêm vòng lặp

Sub MangDechRacRoi()
Dim Vung(), Mg(), i As Long, j As Long, K As Long
[F:G].ClearContents: K = 0
Vung = Range([A1], [A65536].End(xlUp)).Resize(, 2).Value
ReDim Mg(1 To UBound(Vung) - Range([B1], [B50000].End(xlUp)).SpecialCells(xlCellTypeBlanks).Count, 1 To 2)
For i = 1 To UBound(Vung)
If Vung(i, 2) <> "" Then
K = K + 1
For j = 1 To 2
Mg(K, j) = Vung(i, j)
Next
End If
Next
MsgBox UBound(Mg, 1)
[F1].Resize(UBound(Mg, 1), 2).Value = Mg
End Sub

ptm0412 · 9/1/12

cogia đã viết:
Sử dụng như cách của Thầy Ptm quả là "Phức Văn Tạp".

Đúng là phức tạp, mà nếu làm còn dễ bị tẩu hoả nhập ma lắm. Lão chết tiệt bị rồi: Tay quơ quơ chả biết xoay xoay cái gì trước mặt, đầu thì nghiêng nghiêng qua bên trái, miệng lẩm nhẩm hết i, j, k, l rồi lại i, j, l, k, rồi j, i, k, l, ... mấy người chung quanh tưởng điên.

Còn 2 cách của Cò:

Cách 1: Rõ ràng là số vòng lặp tăng gấp đôi, mỗi vòng lặp đều xét 1 cái If, thời gian sẽ ít nhất gấp rưỡi. Chấp nhận được thì cứ xơi.

Cách 2: Dùng SpecialCells(xlCellTypeBlanks) có nguy cơ cao với những ô trống mà không trống, rỗng mà không rỗng:

Ô trống khác với ô công thức trả về rỗng
Ô trống khác với ô rỗng copy từ chỗ khác sang, kể cả paste special value.

ndu96081631 · 9/1/12

ptm0412 đã viết:
Cách 2: Dùng SpecialCells(xlCellTypeBlanks) có nguy cơ cao với những ô trống mà không trống, rỗng mà không rỗng:
.

Một rủi ro đáng sợ nhất: Số lượng Areas vượt quá giới hạn cho phép và khi ấy chẳng thể tưởng tượng nỗi điều gì xảy ra (báo lỗi thì khỏe rồi, chỉ sợ nó sẽ lấy tất tần tật, không chừa thứ gì...)
Vụ này bị hoài khi copy sau AutoFilter với dữ liệu lớn
Ẹc... Ẹc...

concogia · 9/1/12

Túm lại, mấycái rắc rối này đều xuất phát từ anh Ếch Xanh cả thôi
Khai báo số dòng của mảng dư tý tẹo

ReDim Mg(1 To UBound(Vung), 1 To 2)

cũng chẳng chết ẻm nào ( khai báo thiếu nó mới la) khi gán kết quả thì:

[F1].Resize(K, 2).Value = Mg

cho nó nhẹ người, khỏi phải "tính đi toán lại" nhức cả đầu
Chán mớ đời anh Ếch Xanh
Híc

ptm0412 · 9/1/12

concogia đã viết:
Túm lại, mấycái rắc rối này đều xuất phát từ anh Ếch Xanh cả thôi
... khi gán kết quả thì:
[F1].Resize(K, 2).Value = Mg
cho nó nhẹ người, khỏi phải "tính đi toán lại" nhức cả đầu
Híc

Bài 19 cũng đã đề nghị zậy rồi, nhưng Ếch xanh hỏng chịu. Ếch xanh muốn gắn vào combobox chứ không gắn xuống sheet.

Vấn đề sắp xếp hàng trong mảng (1 người xem)

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

Chuyên gia GPE

File đính kèm

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

Chuyên gia GPE

Bad Excel Member

Chuyên gia GPE

Bad Excel Member

Chuyên gia GPE

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

Bad Excel Member

/(hông là gì!

Thành viên tích cực

Cạo lấy gì gội (Dịch quá không gội được)

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

Bad Excel Member

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

Chuyên gia GPE

File đính kèm

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

Chuyên gia GPE

File đính kèm

Bad Excel Member

Chuyên gia GPE

Bad Excel Member

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

Bad Excel Member

Huyền thoại GPE

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

Bad Excel Member

Thời gian đếm ngược.