Thêm, Sửa, Xóa trên ListView

Liên hệ QC

msc0506

Thành viên chính thức
Tham gia
14/4/08
Bài viết
56
Được thích
12
Mình đang cần code thêm sửa xóa trực tiếp trên ListView . Cao thủ nào đã vọc rồi hoặc có ví dụ về vấn đề này giúp mình với nhé, Minh đang cần

Cảm ơn trước
 
Ẹc... Ẹc... gì kỳ vậy!
Chổ này:
PHP:
Private Sub XoaDongTrong()
  On Error Resume Next
  With Sheet1.UsedRange
    .SpecialCells(2).EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .EntireRow.Hidden = False
  End With
End Sub
Sao không dùng SpecialCells(4) nhỉ? Sao phải ẨN, rồi xóa những thằng đang hiện
PHP:
Private Sub XoaDongTrong()
   On Error Resume Next
   Sheet1.UsedRange.SpecialCells(4).EntireRow.Delete
End Sub
 
Upvote 0
Em nghĩ clear và dồn hàng lên là chắc ăn hơn! Bởi đôi khi 2 bảng song song thì không thể dùng UsedRange.SpecialCells(4).EntireRow được!

PHP:
Private Sub UserForm_Terminate()
  Call XoaDongTrong
End Sub

Sub XoaDongTrong()
  Dim Arr(), ArrKQ(1 To 60000, 1 To 2)
  Dim i As Byte, j As Byte, s As Byte, dk As Boolean, k As Long
  k = Sheet1.[A65535].End(xlUp).Row
  Arr = Sheet1.[A2].Resize(k - 1, 2).Value
  s = 0
  For i = 1 To UBound(Arr())
    dk = False
    For j = 1 To 2
      If Arr(i, j) <> "" Then dk = True
    Next
    If dk = True Then
      s = s + 1
      For j = 1 To 2
        ArrKQ(s, j) = Arr(i, j)
      Next
    End If
  Next
  With Sheet1.[A2]
    .Resize(k - 1, 2).ClearContents
    .Resize(s, 2) = ArrKQ
  End With
End Sub
 
Upvote 0
Em nghĩ clear và dồn hàng lên là chắc ăn hơn! Bởi đôi khi 2 bảng song song thì không thể dùng UsedRange.SpecialCells(4).EntireRow được!

PHP:
Private Sub UserForm_Terminate()
  Call XoaDongTrong
End Sub

Sub XoaDongTrong()
  Dim Arr(), ArrKQ(1 To 60000, 1 To 2)
  Dim i As Byte, j As Byte, s As Byte, dk As Boolean, k As Long
  k = Sheet1.[A65535].End(xlUp).Row
  Arr = Sheet1.[A2].Resize(k - 1, 2).Value
  s = 0
  For i = 1 To UBound(Arr())
    dk = False
    For j = 1 To 2
      If Arr(i, j) <> "" Then dk = True
    Next
    If dk = True Then
      s = s + 1
      For j = 1 To 2
        ArrKQ(s, j) = Arr(i, j)
      Next
    End If
  Next
  With Sheet1.[A2]
    .Resize(k - 1, 2).ClearContents
    .Resize(s, 2) = ArrKQ
  End With
End Sub
Trời... Nếu có 2 bảng song song thì đầu tiên khi Form load, bạn xác định vùng dữ liệu đi. Ví dụ:

PHP:
Dim SrcRng as Range
Private Sub UserForm_Initialize()
  Set SrcRng = Sheet1.Range([A2], Sheet1.[B65536].End(xlUp))
  .......
End Sub
Đến lúc thoát form, chỉ cần SrcRng.SpecialCells(4).Delete 2 là được rồi
PHP:
Private Sub UserForm_Terminate()
  SrcRng.SpecialCells(4).Delete 2
End Sub
Chi mà cả đóng For... Next thế
 
Lần chỉnh sửa cuối:
Upvote 0
1. For thừa:
PHP:
  For i = 1 To UBound(Arr())
    dk = False
   For j = 1 To 2
      If Arr(i, j) <> "" Then dk = True
    Next
    If dk = True Then
Tại sao không làm vầy:
PHP:
  For i = 1 To UBound(Arr())
     If Arr(i, 1) & Arr(i, 2) <> "" Then
Khỏi biến dk, khỏi dùng 100 vòng lặp con

2. Còn cái này:
PHP:
      s = s + 1
      For j = 1 To 2
        ArrKQ(s, j) = Arr(i, j)
      Next
sao không phải là:
PHP:
     s = s + 1
      ArrKQ(s, 1) = Arr(i, 1): ArrKQ(s, 2) = Arr(i, 2)
3. Khai báo ArrKQ thừa kích thước:

Đã tính k = Sheet1.[A65535].End(xlUp).Row
thì khai báo ArrKQ tối đa bằng k dòng 2 cột thôi, khai báo làm gì 60 ngàn dòng!
60 ngàn dòng, dư vẫn dư, mà thiếu vẫn thiếu!
 
Lần chỉnh sửa cuối:
Upvote 0
Đúng là em máy móc. Cám ơn Thầy rất nhiều, em đã sửa lại theo Thầy như vầy và code chạy rất nhanh.

PHP:
Private Sub XoaDongTrong()
   On Error Resume Next
   Set Rng = Range(Sheet1.[A2], Sheet1.[B65535].End(xlUp))
   Rng.SpecialCells(4).Delete 2
End Sub
 
Upvote 0
Xin xóa bài này. Cám ơn.
 
Lần chỉnh sửa cuối:
Upvote 0
Còn một thắc mắc nữa là khi sử dụng công thức trong hàng, khi xóa hàng những công thức sẽ không còn nữa, chỉ còn lại Value. Chắc kiểu của nó là vậy!

Cám ơn Thầy PTM, nhờ Thầy mà em đã sửa lại code ngắn gọn hơn rất nhiều, không lủng củng và nhiều vòng lặp, chạy tốt hơn.

PHP:
Sub XoaDongTrong()
  Dim Arr(), ArrKQ
  k = Sheet1.[A65535].End(xlUp).Row
  ReDim ArrKQ(1 To k, 1 To 2)
  Arr = Sheet1.[A2].Resize(k - 1, 2).Value
  j = 0
  For i = 1 To UBound(Arr())
     If Arr(i, 1) & Arr(i, 2) <> "" Then
      j = j + 1
      ArrKQ(j, 1) = Arr(i, 1)
      ArrKQ(j, 2) = Arr(i, 2)
    End If
  Next
  With Sheet1.[A2]
    .Resize(k - 1, 2).ClearContents
    .Resize(j, 2) = ArrKQ
  End With
End Sub
Thì đoạn này .Resize(j, 2) = ArrKQ nó gán Value xuống sheet, lấy đâu mà còn công thức
 
Upvote 0
Còn mục số 3 nữa:

Dim Arr(), ArrKQ
k = Sheet1.[A65535].End(xlUp).Row
ReDim ArrKQ(1 To k, 1 To 2)
...

Còn một thắc mắc nữa là khi sử dụng công thức trong hàng, khi xóa hàng những công thức sẽ không còn nữa, chỉ còn lại Value. Chắc kiểu của nó là vậy!

Cám ơn Thầy PTM, nhờ Thầy mà em đã sửa lại code ngắn gọn hơn rất nhiều, không lủng củng và nhiều vòng lặp, chạy tốt hơn.

PHP:
Sub XoaDongTrong()
  Dim Arr(), ArrKQ
  k = Sheet1.[A65535].End(xlUp).Row
  ReDim ArrKQ(1 To k, 1 To 2)
  Arr = Sheet1.[A2].Resize(k - 1, 2).Value
  j = 0
  For i = 1 To UBound(Arr())
     If Arr(i, 1) & Arr(i, 2) <> "" Then
      j = j + 1
      ArrKQ(j, 1) = Arr(i, 1)
      ArrKQ(j, 2) = Arr(i, 2)
    End If
  Next
  With Sheet1.[A2]
    .Resize(k - 1, 2).ClearContents
    .Resize(j, 2) = ArrKQ
  End With
End Sub
 
Upvote 0
Thầy kiểm tra dùm xem, cái này (Rng.SpecialCells(4).Delete 2) nó cũng không còn công thức!
Đưa file có công thức lên đây đi chứ
Mà tôi đã thử và thấy hổng có vấn đề gì đâu nha (chỉ là công thức bị thay đổi tham chiếu) ---> Nó xóa dòng chứ có đụng gì đến công thức đâu mà mất?
 
Lần chỉnh sửa cuối:
Upvote 0
Sử dụng Array thì phải chấp nhận mất công thức.

Còn dùng lệnh xoá kiểu ndu:

SrcRng.SpecialCells(4).Delete 2

Không mất công thức, nhưng tham chiếu có thể chạy bậy. Ngoài ra, nếu công thức tham chiếu đến dòng bị xoá sẽ bị lỗi.

Một vấn đề lớn nữa: Xoá kiểu ndu thì phải bảo đảm rằng dòng nào trống, là trống hết cả 2 ô, nếu 1 ô trống 1 ô có dữ liệu, nó xoá ô rồi dồn ở dưới lên so le ráng chịu.
 
Upvote 0
Để gút lại các câu hỏi của tôi và đưa ra giải pháp tối ưu (theo tôi), thì tôi đã học được và làm được các code như sau:

PHP:
Option Explicit
Dim lsvItem As ListItem
Dim i As Long, j As Long, k As Long
Dim SrcRng As Range
 
''------------------------------------------------------------------------
 
 
Private Sub UserForm_Initialize()
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Call FillDefault
  Set SrcRng = Sheet1.Range([A2], Sheet1.[B65536].End(xlUp))
  With ListView1
    .ColumnHeaders.Clear: .ListItems.Clear
    For i = 1 To 2
      .ColumnHeaders.Add , , Sheet1.Cells(1, i), 130
    Next
    .ColumnHeaders.Add , , "LINE", 0
    For j = 1 To Sheet1.[A65535].End(xlUp).Row - 1
      Set lsvItem = .ListItems.Add(, , Sheet1.Cells(j + 1, "A"))
      For k = 1 To 2
        Select Case k
          Case 2: lsvItem.SubItems(k) = Format(Cells(j + 1, k + 1).Row, "00000") 
          Case Else: lsvItem.SubItems(k) = Sheet1.Cells(j + 1, k + 1)
        End Select
    Next k, j
  End With
End Sub
 
 
''------------------------------------------------------------------------
 
Private Sub FillDefault()
  With Sheet1
    .[A2].Value = "HTN0001"
    .[B2].Value = "HOANG TRONG NGHIA 0001"
    .[A2:B2].AutoFill Destination:=.[A2:B2001], Type:=xlFillDefault
  End With
End Sub
 
'------------------------------------------------------------------------
 
Private Sub UserForm_Terminate()
  On Error Resume Next
  SrcRng.SpecialCells(4).Delete 2
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

PHP:
Private Sub CommandButton1_Click()
  With CommandButton1
    For Each lsvItem In Me.ListView1.ListItems
      lsvItem.Checked = .Caption = "Check ALL"
    Next
    .Caption = IIf(.Caption = "Check ALL", "UnCheck ALL", "Check ALL")
  End With
End Sub
 
'------------------------------------------------------------------------
 
Private Sub CommandButton2_Click()
  With ListView1
    For i = .ListItems.Count To 1 Step -1
      If .ListItems(i).Checked Then
        j = .ListItems(i).ListSubItems(2)
        Sheet1.Range("A" & j, "B" & j).ClearContents
        .ListItems.Remove i
      End If
    Next
  End With
End Sub

PHP:
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  Call ListViewSort(ListView1, ColumnHeader)
End Sub
 
'------------------------------------------------------------------------
 
Private Sub ListViewSort(mLView As ListView, ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  With mLView
    .Sorted = True
    .SortKey = ColumnHeader.SubItemIndex
    If .SortOrder = lvwDescending Then
      .SortOrder = lvwAscending
    Else
      .SortOrder = lvwDescending
    End If
    .Sorted = False
  End With
End Sub

Cám ơn Thầy PTM, Thầy NDU và Thầy SEALAND đã tận tình hướng dẫn ạ.
 

File đính kèm

  • HOC_3_LISTVIEW.xls
    64 KB · Đọc: 143
Lần chỉnh sửa cuối:
Upvote 0
Cách của các bạn vẫn chưa gọn (Nãy giờ bận không tham gia được)

Code gộp thế này thôi,

Mã:
Private Sub CommandButton2_Click()
Dim Rs As String, j
  With ListView1
    For i = .ListItems.Count To 1 Step -1
      If .ListItems(i).Checked Then
        j = .ListItems(i).ListSubItems(2)
        Rs = IIf(Len(ds) = 0, j & ":" & j, ds & "," & j & ":" & j)
        .ListItems.Remove i
      End If
    Next
  End With
  Sheet1.Range(Rs).Delete
End Sub
 
Upvote 0
Cách của các bạn vẫn chưa gọn (Nãy giờ bận không tham gia được)

Code gộp thế này thôi,

Mã:
Private Sub CommandButton2_Click()
Dim Rs As String, j
With ListView1
For i = .ListItems.Count To 1 Step -1
If .ListItems(i).Checked Then
j = .ListItems(i).ListSubItems(2)
Rs = IIf(Len(ds) = 0, j & ":" & j, ds & "," & j & ":" & j)
.ListItems.Remove i
End If
Next
End With
Sheet1.Range(Rs).Delete
End Sub

Cho em hỏi (ds) là cái gì vậy? Còn tại sao em đã chọn CLEAR thay cho DELETE thì đã nói rõ rồi, vì khi SORT thì không thể nào chính xác được đâu, nếu chỉ xóa lần đầu thì đúng, nhưng thử xóa nhiều lần trong một lần mở Form thì sẽ bị sai đó, còn nếu muốn dùng DELETE thì mỗi lần xóa Anh phải Update lại ListView thôi. Anh kiểm tra lại xem nhé!
 
Upvote 0
Theo dỏi từ đầu đến giờ mà tôi vẫn không hiểu vỉ nguyên nhân gì Learning_Excel phải dùng Listview... Còn tôi thì thà dùng Listbox, cao cấp hơn, dùng luôn SpreadSheet cho nó ngon vì mọi thao tác y chang như trên sheet
Listview chả thấy ngon chổ nào (trừ khả năng DrapDrop)
(Đương nhiên, khi quyết định dùng 1 Control nào đó, ta phải thấy được tính ưu việt của nó mà các Control khác không có)
 
Upvote 0
Theo dỏi từ đầu đến giờ mà tôi vẫn không hiểu vỉ nguyên nhân gì Learning_Excel phải dùng Listview... Còn tôi thì thà dùng Listbox, cao cấp hơn, dùng luôn SpreadSheet cho nó ngon vì mọi thao tác y chang như trên sheet
Listview chả thấy ngon chổ nào (trừ khả năng DrapDrop)
(Đương nhiên, khi quyết định dùng 1 Control nào đó, ta phải thấy được tính ưu việt của nó mà các Control khác không có)

ListView hơn Listbox chứ Anh, giao diện đẹp hơn, thanh trượt mượt mà hơn và có thể cuộn bằng bánh lăn con chuột, còn Listbox không có, có tiêu đề cột, sort từng cột, có grid line, thậm chí nếu khai thác tốt có thể hiển thị Icon trên từng mục, từng tiêu đề cột... Còn SpreadSheet cũng hay, nhưng do em không biết khai thác tốt nên khi cho vào form thì lại có cảm giác làm trên sheet, như vậy thà làm trong sheet tốt hơn, vã lại em không thích nó hiện cả đống control (tool box, menu) trên đó.

Nói chung do sở thích của mỗi người, nhưng cũng chẳng phải em làm chương trình gì lớn lao, chỉ là học và biết cách sử dụng từng control trong Form thôi ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Còn SpreadSheet cũng hay, nhưng do em không biết khai thác tốt nên khi cho vào form thì lại có cảm giác làm trên sheet, như vậy thà làm trong sheet tốt hơn, vã lại em không thích nó hiện cả đống control (tool box, menu) trên đó.

Nói chung do sở thích của mỗi người, nhưng cũng chẳng phải em làm chương trình gì lớn lao, chỉ là học và biết cách sử dụng từng control trong Form thôi ạ.
- Nếu chỉ vì nó giống như giao diện của Worksheet mà ta không xài thì.. hơi buồn cười ---> Phải chọn Control nó khác đi cho người ta không biết mình làm cái gì chăng?
- Mấy cái Menu ấy, nếu không thích thì có thể cho nó "lặn" đi mà
- Còn cái vụ lăn chuột, SpreadSheet bạn lăn tới "trời" còn được nữa là
- Riêng về cái vụ không hổ trợ Unicode thì tôi chấm Listview = Zero điểm
===> Nói tóm lại, theo ý kiến cá nhân của tôi thì thằng Listview chỉ là dạng lưng lững, hơn được Listbox có tí xíu và còn thua SpreadSheet xa lắc
Nói thêm: Listview khó điều khiển thế mà bạn còn làm được thì SpreadSheet có vấn đề gì đâu chứ? Cách viết code y chang như trên sheet (cũng Range, Cells, Row, Column.. vân vân...)
Xem thử ở đây tôi vừa viết xong nè:
http://www.giaiphapexcel.com/forum/showthread.php?47324-T%C6%B0-v%E1%BA%A5n-d%C3%B9m-Form-nh%E1%BA%ADp-li%E1%BB%87u
Nhưng mà thôi, đúng là mỗi người mỗi ý... ẹc... ẹc...
 
Upvote 0
Rồi, máy em tiêu rồi, mấy tháng trước còn dùng SpreadSheet được, nay không cho luôn! Mở File của Thầy ra trong cái Form nó mất hẳn cái SpreadSheet luôn! Chạy Referenced thấy Missing ... đành bỏ check, kiểm tra Addition Ctrols nó chết ngắt luôn rồi! Sao kỳ vậy trời, thư viện nào tự nhiên chiếm chỗ nó thế chẳng biết, mà em có cài đặt gì thêm đâu nhỉ?
 
Upvote 0
1. For thừa:
PHP:
 For i = 1 To UBound(Arr())
dk = False
For j = 1 To 2
If Arr(i, j) <> "" Then dk = True
Next
If dk = True Then
Tại sao không làm vầy:
PHP:
 For i = 1 To UBound(Arr())
If Arr(i, 1) & Arr(i, 2) <> "" Then
Khỏi biến dk, khỏi dùng 100 vòng lặp con

2. Còn cái này:
PHP:
 s = s + 1
For j = 1 To 2
ArrKQ(s, j) = Arr(i, j)
Next
sao không phải là:
PHP:
 s = s + 1
ArrKQ(s, 1) = Arr(i, 1): ArrKQ(s, 2) = Arr(i, 2)
3. Khai báo ArrKQ thừa kích thước:

Đã tính k = Sheet1.[A65535].End(xlUp).Row
thì khai báo ArrKQ tối đa bằng k dòng 2 cột thôi, khai báo làm gì 60 ngàn dòng!
60 ngàn dòng, dư vẫn dư, mà thiếu vẫn thiếu!

Sau khi nghiên cứu cách Sư phụ PTM làm, thấy thật ngắn gọn, tuy nhiên, chỉ 2 cột thì còn làm vậy, chứ nhiều cột mà không dùng thêm ít nhất 2 vòng lặp nữa thì sao có thể làm từng chi tiết được, và không thêm điều kiện Boolean để đánh dấu trong mảng thì cũng khó mà giải quyết được.

Em trình độ thấp kém nên hỏi như vậy, không biết Sư phụ có hướng dẫn gì tốt hơn không? Giả sử là 10 cột???
 
Lần chỉnh sửa cuối:
Upvote 0
Tiếp theo...

Với bài này, tôi dùng 12 cột trong 1 bảng tính và dùng nhiều vòng lặp, với mong muốn là được mọi người chỉ dẫn thêm để cải thiện việc học về vòng lặp.

Tôi sử dụng code như sau:
(Vì đã có k nên tôi không dùng For i = 1 To UBound(Arr()) nữa mà chỉ dùng For i = 1 To k)

PHP:
Private Sub NoBlank()
  Dim i As Long, j As Long, vong As Long
  Dim k As Long, dk As Boolean, Arr(), ArrKQ
  k = Sheet1.[A65535].End(xlUp).Row - 2
  ReDim ArrKQ(1 To k, 1 To 12)
    Arr = Sheet1.[A3].Resize(k, 12).Value
      vong = 0
    For i = 1 To k
      dk = False
      For j = 1 To 12
        If Arr(i, j) <> "" Then dk = True
      Next
      If dk = True Then
        vong = vong + 1
        For j = 1 To 12
          ArrKQ(vong, j) = Arr(i, j)
        Next
      End If
    Next
  With Sheet1.[A3]
    .Resize(k, 12).ClearContents
    .Resize(vong, 12) = ArrKQ
  End With
End Sub

PHP:
Private Sub CommandButton1_Click()
  With CommandButton1
    If .Caption = "No Blank" Then Call NoBlank Else Call Temp
    .Caption = IIf(.Caption = "No Blank", "Temp", "No Blank")
  End With
End Sub
 
'---------------------------------------------------------
 
Private Sub Temp()
  Sheet2.[A3:L43].Copy Sheet1.[A3]
End Sub
 

File đính kèm

  • HocVongLap.xls
    56 KB · Đọc: 61
Upvote 0
Với bài này, tôi dùng 12 cột trong 1 bảng tính và dùng nhiều vòng lặp, với mong muốn là được mọi người chỉ dẫn thêm để cải thiện việc học về vòng lặp.

Tôi sử dụng code như sau:
(Vì đã có k nên tôi không dùng For i = 1 To UBound(Arr()) nữa mà chỉ dùng For i = 1 To k)

PHP:
Private Sub NoBlank()
  Dim i As Long, j As Long, vong As Long
  Dim k As Long, dk As Boolean, Arr(), ArrKQ
  k = Sheet1.[A65535].End(xlUp).Row - 2
  ReDim ArrKQ(1 To k, 1 To 12)
    Arr = Sheet1.[A3].Resize(k, 12).Value
      vong = 0
    For i = 1 To k
      dk = False
      For j = 1 To 12
        If Arr(i, j) <> "" Then dk = True
      Next
      If dk = True Then
        vong = vong + 1
        For j = 1 To 12
          ArrKQ(vong, j) = Arr(i, j)
        Next
      End If
    Next
  With Sheet1.[A3]
    .Resize(k, 12).ClearContents
    .Resize(vong, 12) = ArrKQ
  End With
End Sub
PHP:
Private Sub CommandButton1_Click()
  With CommandButton1
    If .Caption = "No Blank" Then Call NoBlank Else Call Temp
    .Caption = IIf(.Caption = "No Blank", "Temp", "No Blank")
  End With
End Sub
 
'---------------------------------------------------------
 
Private Sub Temp()
  Sheet2.[A3:L43].Copy Sheet1.[A3]
End Sub
Xét về mặt giải thuật thì cũng tạm ổn nhưng xét về bố cục để "vận hành" giải thuật trên thì... hơi dở
Chúng ta đang làm công việc xử lý dữ liệu, vậy điều đầu tiên là phải XÁC ĐỊNH DỮ LIỆU rồi ---> Dữ liệu là 1 vùng trên bảng tính hay 1 mảng nào đó do quá trình tính toán trả về... vân vân... Nhưng nói chung phải xác định dữ liệu trước chứ không phải đi xác định k, i, j... gì cả
Sau khi đã xác định dữ liệu rồi thì những thông số khác sẽ được suy ra từ dữ liệu này (ví dụ số dòng, số cột....)
Tại sao phải làm vậy? Để sau này, khi bạn thay đổi vùng dữ liệu thì bạn chỉ sửa 1 chổ duy nhất trên code (là chổ xác định vùng dữ liệu). Tất cả các thông số các tự nó điều chỉnh theo
Tôi sẽ làm như sau:
PHP:
Sub RemoveBlanksRow()
  Dim SrcArr, DesArr, i As Long, j As Long, lRow As Long, k As Long
  SrcArr = Sheet1.UsedRange.Value
  ReDim DesArr(1 To UBound(SrcArr, 1), 1 To UBound(SrcArr, 2))
  For i = 1 To UBound(SrcArr, 1)
    lRow = lRow + 1: k = 0
    For j = 1 To UBound(SrcArr, 2)
      If SrcArr(i, j) = "" Then k = k + 1
      DesArr(lRow, j) = SrcArr(i, j)
    Next
  If k = UBound(SrcArr, 2) Then lRow = lRow - 1
  Next
  Sheet1.UsedRange.Value = DesArr
End Sub
Thuật toán:
- Xác định vùng dữ liệu và gán vào 1 mảng
- Quét dọc, ngang trên toàn bộ mảng này
- Khi quét theo chiều ngang thì ta vẫn gán giá trị vào mảng kết quả nhưng "âm thầm" đến số lượng cell rổng ---> Hết vòng lập sẽ xét xem tổng số lượng cell rổng có = với chiêu rộng của mảng hay không, nếu = thì trừ chỉ số dòng đi 1 đơn vị (để lần sau lại gán tiếp giá trị vào vị trí dòng này)
-----------------------------
Cái tiến: Để tăng mức độ tùy biến, ta nên viết hẳn 1 hàm chuyên làm công việc loại bỏ dòng rổng
Code như sau:
PHP:
Function RemoveBlanksRow(ByVal SrcRng As Range)
  Dim SrcArr, DesArr, i As Long, j As Long, lRow As Long, k As Long
  On Error GoTo ExitFunc
  RemoveBlanksRow = SrcRng.Value
  SrcArr = SrcRng.Value
  RemoveBlanksRow = SrcArr
  ReDim DesArr(1 To UBound(SrcArr, 1), 1 To UBound(SrcArr, 2))
  For i = 1 To UBound(SrcArr, 1)
    lRow = lRow + 1: k = 0
    For j = 1 To UBound(SrcArr, 2)
      If SrcArr(i, j) = "" Then k = k + 1
      DesArr(lRow, j) = SrcArr(i, j)
    Next
  If k = UBound(SrcArr, 2) Then lRow = lRow - 1
  Next
  RemoveBlanksRow = DesArr
ExitFunc:
End Function
Thêm 1 Sub để chạy code dựa vào hàm trên
PHP:
Sub Main()
  With Sheet1.UsedRange
    .Value = RemoveBlanksRow(.Cells)
  End With
End Sub
------------------------
Ủa! Mà bài này liên quan gì đến ListView nhỉ? Lý ra bạn phải cho vào chuyên mục có liên quan chứ
 

File đính kèm

  • HocVongLap.xls
    61.5 KB · Đọc: 90
Upvote 0
Web KT
Back
Top Bottom