Thêm, Sửa, Xóa trên ListView (1 người xem)

  • Thread starter Thread starter msc0506
  • Ngày gửi Ngày gửi
Liên hệ QC

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

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
 
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

Trên diễn đàn đã có rất nhiều về vấn đề này. Bạn chịu khó tìm kiếm nhé.

1. Lấy dữ liệu từ ListView : Hàng i

PHP:
    i = Me.H_LV.SelectedItem.Index
    Ma = Me.H_LV.SelectedItem.Text         ' Cot 1 
   With Me.H_LV.ListItems.Item(i)
        Me.H_CBTrainMa = .SubItems(1)       ' Cot 2
        Me.H_TBTrainTen = .SubItems(2)      ' Cot 3
        Me.H_CBPeriodMa = .SubItems(3)
        Me.H_TBStart = Format(.SubItems(4), "dd/mm/yyyy")
        Me.H_TBFinish = Format(.SubItems(5), "dd/mm/yyyy")
        Me.H_CBLocationMa = .SubItems(6)
        Me.H_CBCategoryMa = .SubItems(7)
        Me.H_CBVenueMa = .SubItems(8)
        Me.H_CBTrainerMa = .SubItems(9)
    End With
2. Sửa dữ liệu hàng i thì làm tương tự


3. Thêm mới dữ liệu vào ListView

PHP:
           iRLV = .H_LV.ListItems.Count + 1
            ' Luu vao cot dau hang cuoi List View
            .H_LV.ListItems.Add().Text = .H_TBID
        With .H_LV.ListItems.Item(iRLV)
            .SubItems(1) = Me.H_CBTrainMa     ' Cot 2
            .SubItems(2) = Me.H_TBTrainTen   ' Cot 3
            .SubItems(3) = Me.H_CBPeriodMa     ' Cot 4
            .SubItems(4) = Me.H_TBStart      'Cot 5
            .SubItems(5) = Me.H_TBFinish      ' Cot 6
            .SubItems(6) = Me.H_CBLocationMa  ' Cot 7
            .SubItems(7) = Me.H_CBCategoryMa  ' Cot 8
            .SubItems(8) = Me.H_CBVenueMa      ' Cot 9
            .SubItems(9) = Me.H_CBTrainerMa   ' Cot 10
        End With
4. Xóa hàng i:
PHP:
Me.H_LV.ListItems.Remove (i)
Nhìn chung là như vậy.


Thân!
 
Upvote 0
Em làm thêm, xóa được rồi nhưng còn sửa thì em chưa hiểu cho lắm (em viết bằng C#) nhờ các anh, chị giúp em
 
Upvote 0
Xin vui lòng cho hỏi, có thể chọn bất kỳ hàng nào trong ListView, thì hàng đó chuyển lên (scroll lên trên, không phải sort) lên trên cùng của ListView hay không?

Xin cám ơn rất nhiều.
 
Upvote 0
Upvote 0
Theo mình nên đơn giản hoá vấn đề thôi, bạn thử cách "thủ công" của mình xem sao:

Mã:
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim k 'So dong hien thi cua Listview
k = 12
Me.ListView1.ListItems(Item.Index).EnsureVisible
Me.ListView1.ListItems(Item.Index + k).EnsureVisible
Me.ListView1.SelectedItem = Me.ListView1.ListItems(Item.Index)
End Sub
Đồng thời Listview phải thêm số dòng trống bằng số dong của Listview để dòng cuối cùng có thể lên trên cùng
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Theo mình nên đơn giản hoá vấn đề thôi, bạn thử cách "thủ công" của mình xem sao:

Mã:
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim k 'So dong hien thi cua Listview
k = 12
Me.ListView1.ListItems(Item.Index).EnsureVisible
Me.ListView1.ListItems(Item.Index + k).EnsureVisible
Me.ListView1.SelectedItem = Me.ListView1.ListItems(Item.Index)
End Sub
Đồng thời Listview phải thêm số dòng trống bằng số dong của Listview để dòng cuối cùng có thể lên trên cùng
Như ta biết thì Listview có thể OLE_Dragdrop (giống như các control trong VB vậy) nên nó có khả năng kéo thả rất hay
Em đã làm được vụ kéo thả tại đây: http://www.giaiphapexcel.com/forum/showthread.php?7146-Đố-vui-về-VBA!&p=292742#post292742
Còn vụ kéo Item trong chính Listview thì... đang nghiên cứu
Còn đây là code cho UserForm với 1 ListBox (listbox chứ hổng phải Listview nha)... có khả năng kéo thả các Item đây
PHP:
Private mobjFromList As MSForms.ListBox
Private mlFrom As Long
PHP:
Private Sub UserForm_Initialize()
  Dim i As Long
  For i = 0 To 50
    Me.ListBox1.AddItem "Item " & i
  Next
End Sub
PHP:
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Dim objData As DataObject, lEffect As Long
  If Button = 1 Then
    Set objData = New DataObject
    Set mobjFromList = Me.ListBox1
    objData.SetText Me.ListBox1.Text
    mlFrom = Me.ListBox1.ListIndex
    lEffect = objData.StartDrag
  End If
End Sub
PHP:
Private Sub ListBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
  Cancel = True: Effect = fmDropEffectMove
End Sub
PHP:
Private Sub ListBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
  Dim lTo As Long
  With Me.ListBox1
    lTo = .TopIndex + Int(Y * 0.85 / .Font.Size)
    If lTo >= .ListCount Then lTo = .ListCount
    Cancel = True
    Effect = fmDropEffectMove
    .AddItem Data.GetText, lTo
    If mobjFromList = Me.ListBox1 And lTo < mlFrom Then
      mobjFromList.RemoveItem (mlFrom + 1)
    Else
      mobjFromList.RemoveItem mlFrom
    End If
    Set mobjFromList = Nothing
  End With
End Sub
Có ai biết vụ Drag&Drop trong Listview không, chia sẽ với
 

File đính kèm

Upvote 0

Với code này:
PHP:
Public Sub ListViewMoveToTop(ByVal lv As ListView)
    Dim bWasUnSel As Boolean
    Dim tmpLvItem As ListItem
    Dim newLvItem As ListItem
    Dim tmpSubItem As ListSubItem
    Dim i As Integer
    bWasUnSel = False
    For i = 1 To lv.ListItems.Count
        Set tmpLvItem = lv.ListItems(i)
        If tmpLvItem.Selected Then
            If bWasUnSel Then
                Set newLvItem = lv.ListItems.Add(1, , tmpLvItem.Text)
                newLvItem.Tag = tmpLvItem.Tag
                newLvItem.Checked = tmpLvItem.Checked
                newLvItem.Key = tmpLvItem.Key
                For Each tmpSubItem In tmpLvItem.ListSubItems
                    newLvItem.SubItems(tmpSubItem.Index) = tmpSubItem.Text
                Next
                lv.ListItems.Remove (tmpLvItem.Index)
                newLvItem.Selected = True
                Set newLvItem = Nothing
            End If
        Else
            bWasUnSel = True
        End If
        Set tmpLvItem = Nothing
    Next
End Sub

Nó chỉ chuyển dời từ một vị trí đang chọn Add lên trên Top và xóa cái đang chọn, chứ không thể Scroll lên trên nên chưa thể giải quyết được vấn đề của em.



Theo mình nên đơn giản hoá vấn đề thôi, bạn thử cách "thủ công" của mình xem sao:

Mã:
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim k 'So dong hien thi cua Listview
k = 12
Me.ListView1.ListItems(Item.Index).EnsureVisible
Me.ListView1.ListItems(Item.Index + k).EnsureVisible
Me.ListView1.SelectedItem = Me.ListView1.ListItems(Item.Index)
End Sub
Đồng thời Listview phải thêm số dòng trống bằng số dong của Listview để dòng cuối cùng có thể lên trên cùng

Với code của Anh Sealand đúng là Scroll thực sự, nhưng nếu có thể Anh làm ơn viết nó thành dạng
Public Sub ListViewMoveToTop(ByVal lv As ListView) có được không ạ?

Và nếu chọn k là số hàng hiện trên ListView thì làm sao xác định được là bao nhiêu hàng ạ?

Xin cám ơn.
 
Upvote 0
Nó chỉ chuyển dời từ một vị trí đang chọn Add lên trên Top và xóa cái đang chọn, chứ không thể Scroll lên trên nên chưa thể giải quyết được vấn đề của em.
Trời ơi... thì áp code của anh sealand vào là xong mà
PHP:
Private Sub Listview1_DblClick()
  ListViewMoveToTop ListView1
  ListView1.ListItems(1).EnsureVisible
End Sub
PHP:
Private Sub UserForm_Initialize()
  Dim i As Long
  ListView1.ColumnHeaders.Add , , "", 100
  For i = 1 To 20
    ListView1.ListItems.Add , , "Item" & i
  Next
End Sub
PHP:
Private Sub ListViewMoveToTop(ByVal lv As ListView)
  Dim bWasUnSel As Boolean, tmpLvItem As ListItem, newLvItem As ListItem
  Dim tmpSubItem As ListSubItem, i As Integer
  bWasUnSel = False
  For i = 1 To lv.ListItems.Count
    Set tmpLvItem = lv.ListItems(i)
    If tmpLvItem.Selected Then
      If bWasUnSel Then
        Set newLvItem = lv.ListItems.Add(1, , tmpLvItem.Text)
        newLvItem.Tag = tmpLvItem.Tag
        newLvItem.Checked = tmpLvItem.Checked
        newLvItem.Key = tmpLvItem.Key
        For Each tmpSubItem In tmpLvItem.ListSubItems
          newLvItem.SubItems(tmpSubItem.Index) = tmpSubItem.Text
        Next
        lv.ListItems.Remove (tmpLvItem.Index)
        newLvItem.Selected = True
        Set newLvItem = Nothing
      End If
    Else
      bWasUnSel = True
    End If
    Set tmpLvItem = Nothing
  Next
End Sub
 

File đính kèm

Upvote 0
Thật ra là em cũng dùng Double Click, khi chỉnh sửa lại Item của ListView em muốn nó cuộn lên để kiểm tra những cái dưới nữa ạ. Còn code đó chỉ chuyển dời 1 selectedItem từ dưới lên trên thôi.

Chẳng biết làm sao mà cuộn cái thanh Scroll của nó nữa! hic, cái ListView khó nhai thật!

Nhưng phải công nhận Thầy quá siêu, chỉ nhìn chút là "Ẹc Ẹc" rồi hihihi. Cám ơn Thầy rất nhiều, nhờ bài Thầy em có nhiều hướng mới!
 
Lần chỉnh sửa cuối:
Upvote 0
Thật ra là em cũng dùng Double Click, khi chỉnh sửa lại Item của ListView em muốn nó cuộn lên để kiểm tra những cái dưới nữa ạ. Còn code đó chỉ chuyển dời 1 selectedItem từ dưới lên trên thôi.
Chẳng biết làm sao mà cuộn cái thanh Scroll của nó nữa! hic, cái ListView khó nhai thật!
Bạn nói cuộn thế nào tôi chưa hiểu
Cái của tôi là cuộn lên rồi đấy ---> Mà cuộn lên thì làm sao kiểm tra được cái dưới? Hay ý bạn muốn cuộn xuống đây?
 
Upvote 0
Bạn nói cuộn thế nào tôi chưa hiểu
Cái của tôi là cuộn lên rồi đấy ---> Mà cuộn lên thì làm sao kiểm tra được cái dưới? Hay ý bạn muốn cuộn xuống đây?

Như vầy Thầy ơi, double click vào 1 Item, thì thanh cuộn sẽ cuộn xuống, và cái Iterm mình vừa chọn sẽ nằm trên Top, tức là chỉ cuộn thôi, không phải dời Item mình chọn lên Top, không biết có làm được không ạ? Sao em tìm thuộc tính nó hoài mà không ra.
 
Upvote 0
Mới sưu tầm trên mạng 1 File này, có thể học hỏi thêm ListView một cách cơ bản được.
 

File đính kèm

Upvote 0
Như vầy Thầy ơi, double click vào 1 Item, thì thanh cuộn sẽ cuộn xuống, và cái Iterm mình vừa chọn sẽ nằm trên Top, tức là chỉ cuộn thôi, không phải dời Item mình chọn lên Top, không biết có làm được không ạ? Sao em tìm thuộc tính nó hoài mà không ra.
Thì cái mà anh sealand đã làm ấy, chẳng đúng thế sao?
----------------
Ngoài ra, tôi cho rằng cái hay nhất của Listview chính là OLE_DragDrop ---> Nếu không có nhu cầu dùng đến món này thì cũng chẳng việc gì phải xài Listview cả (đó là chưa nói Listview không hổ trợ tiếng Việt Unicode... Mà hình như món nào có OLE_DragDrop đều thế cả thì phải)
 
Lần chỉnh sửa cuối:
Upvote 0
Thì cái mà anh sealand đã làm ấy, chẳng đúng thế sao?
----------------
Ngoài ra, tôi cho rằng cái hay nhất của Listview chính là OLE_DragDrop ---> Nếu không có nhu cầu dùng đến món này thì cũng chẳng việc gì phải xài Listview cả (đó là chưa nói Listview không hổ trợ tiếng Việt Unicode... Mà hình như món nào có OLE_DragDrop đều thế cả thì phải)

Đúng là như vậy, song khi em mở Form Zoom, ListView tự động thay đổi số hàng hiển thị, chẳng biết làm sao mà làm cho nó đúng!

Code của Anh Seland là thuộc tính ItemClick, em lại muốn chuyển thành macro, nhưng trình độ abc quá nên chẳng biết làm sao.

Dù sao cũng cám ơn Thầy ndu96081631và Anh Sealand rất nhiều ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
Xin vui lòng cho hỏi:

- Để check và uncheck toàn bộ ListItems, code phải viết như thế nào?

- Khi check nhiều mục và muốn remove những mục này thì code phải viết làm sao? Và những mục đó xóa luôn trong sheet như thế nào.

Cám ơn rất nhiều

(xin mượn file của anh Sealand để thực hiện).
 

File đính kèm

Upvote 0
Xin vui lòng cho hỏi:

- Để check và uncheck toàn bộ ListItems, code phải viết như thế nào?

- Khi check nhiều mục và muốn remove những mục này thì code phải viết làm sao? Và những mục đó xóa luôn trong sheet như thế nào.

Cám ơn rất nhiều

(xin mượn file của anh Sealand để thực hiện).
Hỏng biết có cách nào 1 phát làm toàn bộ không nữa?... Tôi chỉ nghĩ được For... Next
PHP:
Private Sub CommandButton1_Click()
  Dim lsvItem As ListItem
  For Each lsvItem In Me.ListView1.ListItems
    lsvItem.Checked = True
  Next
End Sub
lsvItem.Checked = False là UnCheck
 
Upvote 0
Code như sau:
Mã:
Private Sub Check()
Dim i
For i = 1 To Me.ListView1.ListItems.Count
If Me.ListView1.ListItems.Item(i).Checked = False Then Me.ListView1.ListItems.Item(i).Checked = True
Next
End Sub

Private Sub Uncheck()
Dim i
For i = 1 To Me.ListView1.ListItems.Count
If Me.ListView1.ListItems.Item(i).Checked = True Then Me.ListView1.ListItems.Item(i).Checked = False
Next

End Sub
 
Upvote 0
Cám ơn Anh NDU, cám ơn Anh Seland, còn phần Remove nhiều mục đã check và xóa luôn những mục đó trong sheet thì sao ạ?
 
Lần chỉnh sửa cuối:
Upvote 0
Xoá thằng nào trên listview thì dùng lệnh sau ví dụ dòng 2

Me.ListView1.ListItems.Remove (2)

Xoá trên sheet thì dùng find hay index để tìm dòng cần xoá như bình thường
 
Upvote 0
Xoá thằng nào trên listview thì dùng lệnh sau ví dụ dòng 2

Me.ListView1.ListItems.Remove (2)

Xoá trên sheet thì dùng find hay index để tìm dòng cần xoá như bình thường

Dạ, em biết là vậy với điều kiện là xóa từng "thằng" một, nhưng vấn đề là khi mình check nhiều "thằng" và xóa hàng loạt những "thằng" đã check thì làm sao đó mà! Hỏng lẻ không thể làm được hả Anh? Chắc phải có chứ, vì nó đã tạo ra cái checkbox trên listview mà ta?!
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ, em biết là vậy với điều kiện là xóa từng "thằng" một, nhưng vấn đề là khi mình check nhiều "thằng" và xóa hàng loạt những "thằng" đã check thì làm sao đó mà! Hỏng lẻ không thể làm được hả Anh? Chắc phải có chứ, vì nó đã tạo ra cái checkbox trên listview mà ta?!
tiếp tục For next!

Ku nào check = True thì xoá.
 
Upvote 0
Dạ, em biết là vậy với điều kiện là xóa từng "thằng" một, nhưng vấn đề là khi mình check nhiều "thằng" và xóa hàng loạt những "thằng" đã check thì làm sao đó mà! Hỏng lẻ không thể làm được hả Anh? Chắc phải có chứ, vì nó đã tạo ra cái checkbox trên listview mà ta?!
Thì như sư phụ Mỹ đã nói: For... Next, xét em nào Checked = True thì Remove
Có điều phải lưu ý: For Next ngược từ dưới lên:
PHP:
  Dim i As Long
  With ListView1
    For i = .ListItems.Count To 1 Step -1
      If .ListItems(i).Checked Then .ListItems.Remove i
    Next
  End With
 
Upvote 0
Cám ơn các Sư Phụ đã hướng dẫn em, tuy nhiên em còn một thắc mắc nữa là không biết trên máy khác thì sao, song, máy của em thì khi remove Item thì nó không tự dồn hàng lên như ta delete row trong sheet (mặc dù em đã chạy Listview1.Refresh). Vậy làm sao cho nó dồn hàng lên sau khi xóa ạ?
 
Upvote 0
Bạn thay đoạn code sau rồi test nghiên cứu lý do nha

Mã:
Private Sub UserForm_Initialize()
Dim It As ListItem
Dim i
[U]Me.ListView1.View = lvwReport
Me.ListView1.ColumnHeaders.Add 1, , "Danh Sach", 110[/U]
For i = 1 To 50
Me.ListView1.ListItems.Add , , Sheet1.Cells(i, 1)
Next
For i = 1 To 12
Me.ListView1.ListItems.Add , , ""
Next
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thay đoạn code sau rồi test nghiên cứu lý do nha

Mã:
Private Sub UserForm_Initialize()
Dim It As ListItem
Dim i
[U]Me.ListView1.View = lvwReport[/U]
[U]Me.ListView1.ColumnHeaders.Add 1, , "Danh Sach", 110[/U]
For i = 1 To 50
Me.ListView1.ListItems.Add , , Sheet1.Cells(i, 1)
Next
For i = 1 To 12
Me.ListView1.ListItems.Add , , ""
Next
End Sub

Theo code của Anh Sealand thì em nghiệm ra rằng, thứ nhất là phải chọn thuộc tính View là lvwReport, thứ hai là phải thêm header cho cột.

Vấn đề xóa nhiều check thì em làm như sau:

PHP:
Sub DeleteListItemsChecked()
  Dim i As Long, j As Long, Rng As Range
  With ListView1
    For i = 1 To .ListItems.Count
      If .ListItems(i).Checked = True Then
        With Sheet1.[A1:A50]
          Set Rng = .Find(ListView1.ListItems(i), LookIn:=xlValues, LookAt:=xlWhole)
          ''If Not Rng Is Nothing Then Sheet1.Rows(Rng.Row).Delete
          If Not Rng Is Nothing Then Sheet1.Cells(Rng.Row, 1).Delete 2
        End With
      End If
    Next
    For j = .ListItems.Count To 1 Step -1
      If .ListItems(j).Checked Then .ListItems.Remove j
    Next
  End With
End Sub

Lưu ý, với ListItems phải là không có dấu tiếng Việt (unicode) và ListItems không bị trùng; còn nếu nguồn trong sheet là font Unicode và đã convert từ Unicode sang VNI trong Listview thì phải chuyển sang VNI sang Unicode trong Find thì mới xóa chính xác.

Cám ơn Anh NDU và Anh Seland đã tận tình giúp đỡ em.
 
Lần chỉnh sửa cuối:
Upvote 0
Theo code của Anh Sealand thì em nghiệm ra rằng, thứ nhất là phải chọn thuộc tính View là lvwReport, thứ hai là phải thêm header cho cột.

Vấn đề xóa nhiều check thì em làm như sau:

PHP:
Sub DeleteListItemsChecked()
  Dim i As Long, j As Long, Rng As Range
  With ListView1
    For i = 1 To .ListItems.Count
      If .ListItems(i).Checked = True Then
        With Sheet1.[A1:A50]
          Set Rng = .Find(ListView1.ListItems(i), LookIn:=xlValues, LookAt:=xlWhole)
          ''If Not Rng Is Nothing Then Sheet1.Rows(Rng.Row).Delete
          If Not Rng Is Nothing Then Sheet1.Cells(Rng.Row, 1).Delete 2
        End With
      End If
    Next
    For j = .ListItems.Count To 1 Step -1
      If .ListItems(j).Checked Then .ListItems.Remove j
    Next
  End With
End Sub

Lưu ý, với ListItems phải là không có dấu tiếng Việt (unicode) và ListItems không bị trùng; còn nếu nguồn trong sheet là font Unicode và đã convert từ Unicode sang VNI trong Listview thì phải chuyển sang VNI sang Unicode trong Find thì mới xóa chính xác.

Cám ơn Anh NDU và Anh Seland đã tận tình giúp đỡ em.
Xóa Item trong Listview và xóa dữ liệu trên sheet sao không làm 1 lần luôn mà phải chia ra 2 vòng lập For thế nhỉ?
 
Upvote 0
Xóa Item trong Listview và xóa dữ liệu trên sheet sao không làm 1 lần luôn mà phải chia ra 2 vòng lập For thế nhỉ?
Đúng rồi, tại em lúc đầu thử 2 cái riêng biệt rồi ghép lại, thêm nữa lúc đầu ListItems có dấu tiếng Việt, em chạy hoài nó không xóa, sau khi thử nhiều cách rồi mới biết nguyên nhân là vậy, rồi không kiểm tra lại vòng lặp.

Cám ơn Anh NDU rất nhiều!!!!

PHP:
Private Sub CommandButton2_Click()
  Dim i As Long, Rng As Range
  With ListView1
    For i = .ListItems.Count To 1 Step -1
      If .ListItems(i).Checked Then
        With Sheet1.[A1:A50]
          Set Rng = .Find(ListView1.ListItems(i), LookIn:=xlValues, LookAt:=xlWhole)
          If Not Rng Is Nothing Then Sheet1.Range("A" & Rng.Row, "B" & Rng.Row).Delete 2
        End With
        .ListItems.Remove i
      End If
    Next
  End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
1/Listview mà bạn đang thiết lập ở dạng 1-lvwsmallIcon nên nó có thể di chuyển các Item bằng chuột và không tự dồn dịch được
2/Mình cũng đã sử dụng Listview để tìm xoá thì chắc ăn nhất là thêm cột số dòng và cho độ rộng dòng này bằng không (Nó không hiện ra). Khi xoá thằng nào thì cứ xem số tại cột đó bằng bao nhiêu rồi xoá dòng đó là chắc như đinh.
3/Code của bạn xoá sinh lỗi. Như Ndu đã cảnh báo, bạn phải soát ngược vòng For tránh biến đếm vượt số Item do bị xoá bớt
 
Lần chỉnh sửa cuối:
Upvote 0
2/Mình cũng đã sử dụng Listview để tìm xoá thì chắc ăn nhất là thêm cột số dòng và cho độ rộng dòng này bằng không (Nó không hiện ra). Khi xoá thằng nào thì cứ xem số tại cột đó bằng bao nhiêu rồi xoá dòng đó là chắc như đinh.
Em nghĩ đâu cần thiết phải thêm cột hả anh!
Ví dụ: SrcRng là vùng dữ liệu mà ta Add vào ListView, vậy thì trên ListView, khi ta check tại mục số 5, cũng hoàn toàn tương đương với SrcRng(5,1) trên sheet ---> Cứ thế mà xóa thôi
(Đang nói SrcRng là dữ liệu 1 cột nhiều dòng)
 
Upvote 0
Em nghĩ đâu cần thiết phải thêm cột hả anh!
Ví dụ: SrcRng là vùng dữ liệu mà ta Add vào ListView, vậy thì trên ListView, khi ta check tại mục số 5, cũng hoàn toàn tương đương với SrcRng(5,1) trên sheet ---> Cứ thế mà xóa thôi
(Đang nói SrcRng là dữ liệu 1 cột nhiều dòng)

Đúng như Anh nói, tốt nhất ta định vị hàng trên sheet và ListItems(i).Index rồi xóa là tốt nhất, chắc chắn là không bao giờ sai, với điều kiện xóa từ dưới lên trên (chứ từ trên xuống dưới cũng die luôn).

Em làm như sau:

PHP:
Option Explicit
Dim lsvItem As ListItem, i As Long, j As Long

Private Sub UserForm_Initialize()
  With ListView1
    .ColumnHeaders.Clear: .ListItems.Clear
    For i = 1 To 2
      .ColumnHeaders.Add , , Sheet1.Cells(1, i)
      .ColumnHeaders(i).Width = 130
    Next
    For j = 1 To Sheet1.[A5000].End(xlUp).Row - 1
      Set lsvItem = .ListItems.Add(, , Sheet1.Cells(j + 1, "A"))
      lsvItem.SubItems(1) = Sheet1.Cells(j + 1, 2)
    Next
  End With
End Sub

PHP:
Private Sub CommandButton1_Click()
  If CommandButton1.Caption = "Check ALL" Then
    For Each lsvItem In Me.ListView1.ListItems
      lsvItem.Checked = True
    Next
    CommandButton1.Caption = "UnCheck ALL"
  Else
    For Each lsvItem In Me.ListView1.ListItems
      lsvItem.Checked = False
    Next
    CommandButton1.Caption = "Check ALL"
  End If
End Sub

PHP:
Private Sub CommandButton2_Click()
  With ListView1
    For i = .ListItems.Count To 1 Step -1
      If .ListItems(i).Checked Then
        j = .ListItems(i).Index + 1
        Sheet1.Range("A" & j, "B" & j).Delete 2
        .ListItems.Remove i
      End If
    Next
  End With
End Sub

Như vậy sẽ đơn giản hơn là dùng hàm FIND.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em nghĩ đâu cần thiết phải thêm cột hả anh!
Ví dụ: SrcRng là vùng dữ liệu mà ta Add vào ListView, vậy thì trên ListView, khi ta check tại mục số 5, cũng hoàn toàn tương đương với SrcRng(5,1) trên sheet ---> Cứ thế mà xóa thôi
(Đang nói SrcRng là dữ liệu 1 cột nhiều dòng)

listview nó có phương thức sort, vậy mà dựa vào index thì dễ oan gia lắm.
 
Upvote 0
Đoạn này
PHP:
Private Sub CommandButton1_Click()
  Dim lsvItem As ListItem
  If CommandButton1.Caption = "Check ALL" Then
    For Each lsvItem In Me.ListView1.ListItems
      lsvItem.Checked = True
    Next
    CommandButton1.Caption = "UnCheck ALL"
  Else
    For Each lsvItem In Me.ListView1.ListItems
      lsvItem.Checked = False
    Next
    CommandButton1.Caption = "Check ALL"
  End If
End Sub
Ai lại làm thế!
Tôi sẽ làm vầy:
PHP:
Private Sub CommandButton1_Click()
  Dim lsvItem As ListItem
  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
Có ngắn gọn và đơn giản hơn không?
 
Upvote 0
listview nó có phương thức sort, vậy mà dựa vào index thì dễ oan gia lắm.

Đã kiểm tra, nếu mà SORT thì oan gia thiệt, thử với nó là biết liền! Hic, Hic

PHP:
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

PHP:
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  Call ListViewSort(ListView1, ColumnHeader)
End Sub

Như vậy, muốn dùm hàm FIND hay INDEX để xóa trong sheet, thì người thiết kế phải nắm chắc cơ sở dữ liệu của mình như thế nào để không bị mất dữ liệu "oan". VD, nếu dùng INDEX thì không cho thuộc tính SORT, nếu dùng FIND thì dữ liệu phải không trùng... Có như vậy mới chắc chắn rằng mình xóa "đúng người đúng tội".
 
Lần chỉnh sửa cuối:
Upvote 0
Đã kiểm tra, nếu mà SORT thì oan gia thiệt, thử với nó là biết liền! Hic, Hic

PHP:
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
PHP:
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  Call ListViewSort(ListView1, ColumnHeader)
End Sub
Như vậy, muốn dùm hàm FIND hay INDEX để xóa trong sheet, thì người thiết kế phải nắm chắc cơ sở dữ liệu của mình như thế nào để không bị mất dữ liệu "oan". VD, nếu dùng INDEX thì không cho thuộc tính SORT, nếu dùng FIND thì dữ liệu phải không trùng... Có như vậy mới chắc chắn rằng mình xóa "đúng người đúng tội".
Thật ra cũng chẳng hề gì nếu bạn... khéo
Cứ cho rằng chúng ta sẽ sort trên Listview đi, vậy thì ngay lúc AddItem cho Listview, ta cho list ấy vào 1 Dictionary Object với Dic.Key là các phần tử của Listview còn Dic.Item là STT ---> Mai này tìm kiếm thì cứ tra vào Dictionary mà tìm ra STT tương ứng
Có vấn đề gì không?
Bảo đảm với bạn rằng Find Method không sao bằng tốc độ so với dùng Array đâu
Ôi... vô vàn cách để nghiên cứu, nhưng cách dùng cột phụ như anh sealand thì em cho là... không được "đẹp" lắm
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
Thật ra cũng chẳng hề gì nếu bạn... khéo
Cứ cho rằng chúng ta sẽ sort trên Listview đi, vậy thì ngay lúc AddItem cho Listview, ta cho list ấy vào 1 Dictionary Object với Dic.Key là các phần tử của Listview còn Dic.Item là STT ---> Mai này tìm kiếm thì cứ tra vào Dictionary mà tìm ra STT tương ứng
Có vấn đề gì không?
Bảo đảm với bạn rằng Find Method không sao bằng tốc độ so với dùng Array đâu
Ôi... vô vàn cách để nghiên cứu, nhưng cách dùng cột phụ như anh sealand thì em cho là... không được "đẹp" lắm
Ẹc... Ẹc...

Cũng không sao Anh NDU ơi, với trình độ của em thì làm gì biết cách Dictionary Oject chứ, nhưng nếu làm cột phụ sau đó add số dòng lên đó, rồi cho Listview1.ColumnHeaders(cột phụ).Width = 0 thì nhìn vào ai biết gì mà xấu phải không?

Kiểm tra lại, nếu dùng cột phụ rồi add số hàng lên, sau khi sort cũng bị dính chưởng như thường! Ẹc ... Ẹc ...

PHP:
Private Sub UserForm_Initialize()
  With ListView1
    .ColumnHeaders.Clear: .ListItems.Clear
    For i = 1 To 2
      .ColumnHeaders.Add , , Sheet1.Cells(1, i)
      .ColumnHeaders(i).Width = 130
    Next
      .ColumnHeaders.Add , , "LINE"
      .ColumnHeaders(3).Width = 0
    For j = 1 To Sheet1.[A5000].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") '<-- dung de sort moi dinh dang
          Case Else: lsvItem.SubItems(k) = Sheet1.Cells(j + 1, k + 1)
        End Select
    Next k, j
  End With
End Sub

PHP:
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).Delete 2
        .ListItems.Remove i
      End If
    Next
  End With
End Sub

Cách của Anh NDU về việc dùng DIC thì em không biết, nhưng chắc phải tùy thuộc vào cách mà mình quyết định trên Listview theo cơ sở dữ liệu của mình mà thực hiện thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Bảo đảm với bạn rằng Find Method không sao bằng tốc độ so với dùng Array đâu
Ôi... vô vàn cách để nghiên cứu, nhưng cách dùng cột phụ như anh sealand thì em cho là... không được "đẹp" lắm
Ẹc... Ẹc...

Mình lại nghĩ khác, khi sử lý các vấn đề phức tạp khác nó sẽ nảy sinh vấn đề xung đột. Luôn có 1 cái dictionnary tồn tại trong suốt quá trình tồn tại form. Động tác tra chưa chắc nhanh gọn hơn lấy subitem.
Mình lưu ý là để ở sublistem chứ không ở listitem.
 
Upvote 0
Mình lại nghĩ khác, khi sử lý các vấn đề phức tạp khác nó sẽ nảy sinh vấn đề xung đột. Luôn có 1 cái dictionnary tồn tại trong suốt quá trình tồn tại form. Động tác tra chưa chắc nhanh gọn hơn lấy subitem.
Mình lưu ý là để ở sublistem chứ không ở listitem.
Tra Dictionary và lấy Index là y chang nhau mà anh..
Và dù làm cách nào đi nữa thì sau khi xóa dữ liệu trên sheet, vẫn phải cập nhật lại STT thôi (cách của anh thì phải đánh lại STT ở SubItem, cách của em là nạp lại STT cho Dic.Item)
Vậy thôi! Ẹc... Ẹc...
 
Upvote 0
Em đã tìm ra giải pháp. Thay vì Delete Row, ta chỉ Clear tạm thời trong suốt quá trình hoạt động của Form, sau đó khi Form Unload ta xóa dòng trống là ổn cả, như vậy là tuyệt vời!

PHP:
Private Sub UserForm_Terminate()
  Call XoaDongTrong
End Sub
 
'----------------------------------------------
 
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

PHP:
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).Clear '<--- thay cho Delete
        .ListItems.Remove i
      End If
    Next
  End With
End Sub
 

File đính kèm

Upvote 0
Ẹ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

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

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

Upvote 0
Cám ơn Thầy Ndu rất rất nhiều ạ, đúng là em có lấn cấn vùng dữ liệu, phải tìm được "row max", rồi mới tính tiếp chuyện xử lý, bởi thế nên rất băn khoăn về nó, nhờ Thầy em đã sáng tỏ vấn đề và học hỏi rất nhiều. Nếu dùng EntireRow.SpecialCells(4) thì quá nguy hiểm, bởi phải đảm bảo rằng những hàng không bị xóa thì tất cả các cell trong hàng đó phải "non blank", nếu không tại cell đó sẽ bị xóa và cell của hàng dưới lại chuyển lên hàng trên... Cho nên, hàm của Thầy thật là tổng quát, em thử trên 65 ngàn dòng, code chạy rất êm và nhanh!

Đúng là phải hỏi qua chuyên đề khác, nhưng do xóa trên ListView nó lại liên quan đến cơ sở dữ liệu trên sheet nên hỏi tiếp theo luôn ạ.

Cám ơn Thầy nhiều!
 
Upvote 0
Cám ơn Thầy Ndu rất rất nhiều ạ, đúng là em có lấn cấn vùng dữ liệu, phải tìm được "row max", rồi mới tính tiếp chuyện xử lý, bởi thế nên rất băn khoăn về nó, nhờ Thầy em đã sáng tỏ vấn đề và học hỏi rất nhiều. Nếu dùng EntireRow.SpecialCells(4) thì quá nguy hiểm, bởi phải đảm bảo rằng những hàng không bị xóa thì tất cả các cell trong hàng đó phải "non blank", nếu không tại cell đó sẽ bị xóa và cell của hàng dưới lại chuyển lên hàng trên... Cho nên, hàm của Thầy thật là tổng quát, em thử trên 65 ngàn dòng, code chạy rất êm và nhanh!

Đúng là phải hỏi qua chuyên đề khác, nhưng do xóa trên ListView nó lại liên quan đến cơ sở dữ liệu trên sheet nên hỏi tiếp theo luôn ạ.

Cám ơn Thầy nhiều!
Để tăng tốc ta chuyển mọi thứ sang Array. Và khi đã chuyển sang Array rồi thì không được tính toán bất cứ thứ gì liên quan đến ROW, COLUMN, CELLS, RANGE gì gì cả
Code của tôi vẫn chưa tổng quát đâu, vẫn còn SrcRng thuộc biến Range ---> Chính vậy mà nó không thể áp dụng với Source là Mảng được
Nếu có thời gian, bạn cải tiến toàn bộ thành mảng luôn đi, tức có thể hoạt động với Range hay bất cứ Array nào.
Cải tiến:
Mã:
Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcRng As Range[/B][/COLOR])
Thành
Mã:
Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcArray As Variant[/B][/COLOR])
Nói chung mọi thứ gần như giống với code cũ, chỉ chú ý 1 chuyện quan trọng: Khi ấy ta không biết trước LBound(SrcArray) là = 0 hay = 1 nha
 
Upvote 0
Để tăng tốc ta chuyển mọi thứ sang Array. Và khi đã chuyển sang Array rồi thì không được tính toán bất cứ thứ gì liên quan đến ROW, COLUMN, CELLS, RANGE gì gì cả
Code của tôi vẫn chưa tổng quát đâu, vẫn còn SrcRng thuộc biến Range ---> Chính vậy mà nó không thể áp dụng với Source là Mảng được
Nếu có thời gian, bạn cải tiến toàn bộ thành mảng luôn đi, tức có thể hoạt động với Range hay bất cứ Array nào.
Cải tiến:
Mã:
Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcRng As Range[/B][/COLOR])
Thành
Mã:
Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcArray As Variant[/B][/COLOR])
Nói chung mọi thứ gần như giống với code cũ, chỉ chú ý 1 chuyện quan trọng: Khi ấy ta không biết trước LBound(SrcArray) là = 0 hay = 1 nha

Thì mình quy định trong Module là Option Base 0 là được rồi phải không thưa Thầy?

Còn một lấn cấn nữa nếu tổng quát thêm 1 tí nữa được không ạ? Thay vì là RemoveBlanksRow(.Cells), thì thay vào đó ta chỉ cho Xóa trong giới hạn cột được không ạ, như là RemoveBlanksRow(.Columns("A:L")) chẳng hạn?
 
Upvote 0
Thì mình quy định trong Module là Option Base 0 là được rồi phải không thưa Thầy?
Chẳng ăn thua gì. Cái Option Base ấy hoàn toàn không có tác dụng với 1 mảng có sẳn ---> Ví dụ mảng do Range tạo thành luôn là Base 1, cho dù bạn có Option thế nào
Còn một lấn cấn nữa nếu tổng quát thêm 1 tí nữa được không ạ? Thay vì là RemoveBlanksRow(.Cells), thì thay vào đó ta chỉ cho Xóa trong giới hạn cột được không ạ, như là RemoveBlanksRow(.Columns("A:L")) chẳng hạn?
Có gì đâu mà lấn cấn, bạn xác định vùng dữ liệu là chổ nào thì nó sẽ hoạt động chổ đó thôi ---> File của tôi ở trên xác định vùng là UsedRange thì nó hoạt động với UsedRange. Trường hợp cụ thế có khác hơn thì cứ việc thế vào cho phù hợp
Ví dụ thế này
PHP:
Sub Main()
    With Sheet1.Range("A:L")
       .Value = RemoveBlanksRow(.Cells)
    End With
End Sub
 
Lần chỉnh sửa cuối:
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 ạ.

Mượn File của bài này, vui lòng cho tôi hỏi làm sao để nhận biết ít nhất là 1 ListItem được check?

Nếu check bằng thủ công ít nhất là 1 mục, hoặc check bằng lệnh check tất cả, thì nút Xóa nhiều mục Enable=True, vậy tôi phải làm sao? Ngược lại, không có mục nào được check thì Enable=False.

Xin cám ơn.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mượn File của bài này, vui lòng cho tôi hỏi làm sao để nhận biết ít nhất là 1 ListItem được check?

Nếu check bằng thủ công ít nhất là 1 mục, hoặc check bằng lệnh check tất cả, thì nút Xóa nhiều mục Enable=True, vậy tôi phải làm sao? Ngược lại, không có mục nào được check thì Enable=False.

Xin cám ơn.
Thì For next thôi, có gì đâu
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")
    CommandButton2.Enabled = .Caption = "UnCheck ALL"
  End With
End Sub
và:
PHP:
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  CommandButton2.Enabled = False
  For Each lsvItem In Me.ListView1.ListItems
    If lsvItem.Checked Then
      CommandButton2.Enabled = True
      Exit For
    End If
  Next
End Sub
 
Upvote 0
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
chào các bạn,các bạn cho hỏi là: có cách nào sửa dữ liệu trong bảng tính bằng ListBox (ListBox chứ không phải ListView) không?,nếu được các bạn giúp mình với,cảm ơn.
 
Upvote 0
Sửa trưc tiếp thì không được. Tốt nhất là ta liên kết ra textbox. KhanHa Tham khao nha
 

File đính kèm

Upvote 0
Một phương án khác dùng inputbox gọn gàng hơn.
Cần sửa dòng nao thi chuyển vệt sáng về dòng đó rồi DoubleClick. Toàn bộ code chỉ như sau thôi

Mã:
Option Explicit
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cot, Vl1, Vl2, Tm()
Tm = Me.ListBox1.List()
Cancel = True
cot = InputBox("Sua dong hien thoi cot may? (1-5)")
If InStr(1, "1;2;3;4;5", cot) = 0 Then
MsgBox "Sai cot"
Exit Sub
End If
If cot = 1 Then
Vl1 = Me.ListBox1
Else
Vl1 = Me.ListBox1.Column(cot - 1)
End If
Vl2 = InputBox("Nhap gia tri can thay doi", , Vl1)
Tm(Me.ListBox1.ListIndex, cot - 1) = Vl2
Sheet1.Range("A2", [a65536].End(3)).Resize(, 5) = Tm
Me.ListBox1.List() = Tm
End Sub
'========================
Private Sub UserForm_Initialize()
Dim i, Tm
Tm = Sheet1.Range("A2", [a65536].End(3)).Resize(, 5)
Me.ListBox1.List() = Tm
For i = 1 To Me.ListBox1.ColumnCount
Me.ListBox1.ColumnWidths = "70;70;70;150;70"
Next
Me.ListBox1.ListIndex = 0
End Sub

Gửi rồi mới thấy vô duyên, có thể bỏ đoạn lấy Vl1 và biến Vl1 mà lấy ngay biến Tm() đã có sẵn. Tự sửa chút nha.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Sửa trưc tiếp thì không được. Tốt nhất là ta liên kết ra textbox. KhamHa Tham khao nha
Cảm ơn bạn Sealand đã giúp,Theo khamha thử thì không hiểu tại sao Font lào lại không hiện được trong Form sửa (nó hiện toàn ô vuông) mình vào định định dạng lại Font lào,nhưng không thấy cái Form đó (Chắc cái Form đó không phải là Form tự tạo)
Theo mình thì nên thêm một cái Form sửa dữ liệu bằng Form tự tạo thì chắc sẽ định dạng chữ lào được (bạn làm giúp mình nhé)
Trong Form chọn cột,nếu mà thay được bằng một cái ListBox để chọn tiêu đề cột thì tiện biết mấy.Một lần nữa cảm ơn bạn.
 
Upvote 0
Cảm ơn bạn Sealand đã giúp,Theo khamha thử thì không hiểu tại sao Font lào lại không hiện được trong Form sửa (nó hiện toàn ô vuông) mình vào định định dạng lại Font lào,nhưng không thấy cái Form đó (Chắc cái Form đó không phải là Form tự tạo)
Theo mình thì nên thêm một cái Form sửa dữ liệu bằng Form tự tạo thì chắc sẽ định dạng chữ lào được (bạn làm giúp mình nhé)
Trong Form chọn cột,nếu mà thay được bằng một cái ListBox để chọn tiêu đề cột thì tiện biết mấy.Một lần nữa cảm ơn bạn.

Vậy bạn vui lòng gửi File có cái Form font tiếng Lào đó lên đi nhé!
 
Upvote 0
File đây bạn.Mà XP không đọc được đâu (Chỉ có Vista và win 7 mới hiện được chữ lào)

Bạn thử thế này nhé!

Về màn hình desktop, click chuột phải, chọn Properties, Chọn tiếp tab Appearance, click vào nút Advanced. Tại đây, bạn chọn tại Item mục Message Box, sau đó tại mục Font, bạn chọn kiểu font Saysettha Unicode của bạn, sau đó OK.

Hy vọng nó giúp cho bạn cải thiện được lỗi font này.
 
Upvote 0
Bạn thử thế này nhé!

Về màn hình desktop, click chuột phải, chọn Properties, Chọn tiếp tab Appearance, click vào nút Advanced. Tại đây, bạn chọn tại Item mục Message Box, sau đó tại mục Font, bạn chọn kiểu font Saysettha Unicode của bạn, sau đó OK.

Hy vọng nó giúp cho bạn cải thiện được lỗi font này.
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.
 
Upvote 0
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.

Mình cũng vừa mò ra đây! Rất dễ luôn!

Màn hình Desktop, click chuột phải, chọn Personalization, phía dưới cùng có 4 nút, chọn vào nút Window Color. Tại đây, click vào dòng chữ: Avaced Appearance Setting... chọn vào Item và làm như bài trước.

Chúc thành công!
 
Upvote 0
Thôi bạn ơi, đừng làm nữa! Sửa lại những cái vừa cài đặt lại như ban đầu đi, code sửa lại như vầy:

Mã:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cot, Vl1, Vl2
Dim i, j, Tm()
Tm = Me.ListBox1.List()
Cancel = True
cot = [COLOR=#ff0000][B]Application.[/B][/COLOR]InputBox("Sua dong hien thoi cot may? (1-5)")
If InStr(1, "1;2;3;4;5", cot) = 0 Then
MsgBox "Sai cot"
Exit Sub
End If
If cot = 1 Then
Vl1 = Me.ListBox1
Else
Vl1 = Me.ListBox1.Column(cot - 1)
End If
Vl2 = [COLOR=#ff0000][B]Application.[/B][/COLOR]InputBox("Nhap gia tri can thay doi", , Vl1)
Tm(Me.ListBox1.ListIndex, cot - 1) = Vl2
Sheet1.Range("A2", [a65536].End(3)).Resize(, 5) = Tm
Me.ListBox1.List() = Tm
End Sub

Vậy là xong!
 
Upvote 0
Mình cũng vừa mò ra đây! Rất dễ luôn!Màn hình Desktop, click chuột phải, chọn Personalization, phía dưới cùng có 4 nút, chọn vào nút Window Color. Tại đây, click vào dòng chữ: Avaced Appearance Setting... chọn vào Item và làm như bài trước.Chúc thành công!
Cảm ơn bạn,mình chỉnh lại như hướng dẫn nhưng vẫn không có gì thay đổi,chữ lào nếu hiên trên cái Form sửa vẫn là: ??????? (dấu hỏi)
 
Upvote 0
File đây bạn.Mà XP không đọc được đâu (Chỉ có Vista và win 7 mới hiện được chữ lào)
Lạ nhỉ! Tôi mở file này trên WinXP + Office 2003, vẫn xem được thoải mái mà chẳng cần chỉnh bất cứ thứ gì
Nói thêm rằng máy tôi chẳng có font Lào gì đâu nha:

untitled.JPG


Còn cái vụ chỉnh Desktop gì gì đó tốt nhất không nên làm nếu không muốn gặp rắc rối sau này
 
Upvote 0
Bạn phải làm như bài tôi vừa mới gửi đấy! Thêm nữa là bạn cần bẫy lỗi:

Mã:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Dim cot, Vl1, Vl2
Dim i, j, Tm()
Tm = Me.ListBox1.List()
Cancel = True
cot = [COLOR=#ff0000][B]Application.[/B][/COLOR]InputBox("Sua dong hien thoi cot may? (1-5)")
[B][COLOR=#0000cd]If cot = "False" Then Exit Sub[/COLOR][/B]
If InStr(1, "1;2;3;4;5", cot) = 0 Then
MsgBox "Sai cot"
Exit Sub
End If
If cot = 1 Then
Vl1 = Me.ListBox1
Else
Vl1 = Me.ListBox1.Column(cot - 1)
End If
Vl2 = [COLOR=#ff0000][B]Application.[/B][/COLOR]InputBox("Nhap gia tri can thay doi", , Vl1)
[B][COLOR=#0000cd]If Vl2 = "False" Then Exit Sub[/COLOR][/B]
Tm(Me.ListBox1.ListIndex, cot - 1) = Vl2
Sheet1.Range("A2", [a65536].End(3)).Resize(, 5) = Tm
Me.ListBox1.List() = Tm
End Sub
 
Upvote 0
Lạ nhỉ! Tôi mở file này trên WinXP + Office 2003, vẫn xem được thoải mái mà chẳng cần chỉnh bất cứ thứ gì
Nói thêm rằng máy tôi chẳng có font Lào gì đâu nha:




Còn cái vụ chỉnh Desktop gì gì đó tốt nhất không nên làm nếu không muốn gặp rắc rối sau này

Không phải đâu, ý bạn ấy muốn nói là cái InputBox đấy Thầy ơi!

Vì em tìm ra nguyên nhân nên ngay lập tức gọi bạn ấy đừng cài đặt Window nữa và cài đặt lại tình trạng ban đầu thôi.
 
Upvote 0
Lạ nhỉ! Tôi mở file này trên WinXP + Office 2003, vẫn xem được thoải mái mà chẳng cần chỉnh bất cứ thứ gìNói thêm rằng máy tôi chẳng có font Lào gì đâu nha:
View attachment 71859Còn cái vụ chỉnh Desktop gì gì đó tốt nhất không nên làm nếu không muốn gặp rắc rối sau này

Chữ lào Chuẩn nó phải như thế này,bạn xem ảnh.
Loi.jpg
 
Upvote 0
Nhưng cuối cùng bạn có sửa lại như bài #79 chưa vậy? Kết quả như mong đợi chứ?
phải công nhận là kết quả trên cả mong muốn ,nhưng mà tại sao cái form đó nó lại không mở được khi ta ở sheet khác.ý mình muốn là:có thể gọi form và sừa dữ liệu được khi ta ở một sheet khác(vì sheet có dữ liệu sẽ bị ẩn).bạn giúp mình nhé,cảm ơn bạn.
 
Upvote 0
phải công nhận là kết quả trên cả mong muốn ,nhưng mà tại sao cái form đó nó lại không mở được khi ta ở sheet khác.ý mình muốn là:có thể gọi form và sừa dữ liệu được khi ta ở một sheet khác(vì sheet có dữ liệu sẽ bị ẩn).bạn giúp mình nhé,cảm ơn bạn.

Cái listbox nó lấy nguồn tại đâu thì chỉnh sửa tại đó chứ sao bạn! Còn muốn chỉnh sửa ở sheet khác thì listbox phải nạp nguồn ở sheet đó.

Cũng có thể sửa được trên sheet khác nếu cùng mã (ID) sau đó dò tìm và sửa tại sheet đó.
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn đã giải đáp,vấn đề này chắc phải dùng theo cách không ẩn sheet có dữ liệu,thay vào đấy sẽ dùng cách là:khi ta mở form thì cũng tự động mở khóa,khi đóng form thì cũng tự động khóa sheet lại./.Còn một vấn đề nữa nhờ bạn giúp là cách tạo tiêu đề cho ListBox,mình làm bằng cách liên kết tiêu đề của ListBox với tiêu đề trong bảng chứa dữ liệu rồi,mà khi mở form thì bị báo lỗi.cảm ơn bạn.
 
Upvote 0
Để làm điều này chỉ có thể dùng phương thức gán rowsource. Mà cái phương thức này nó lòng vòng thêm. Vậy thì tốt nhất là thêm mấy cái Label là xong.
 
Upvote 0
Để làm điều này chỉ có thể dùng phương thức gán rowsource. Mà cái phương thức này nó lòng vòng thêm. Vậy thì tốt nhất là thêm mấy cái Label là xong.
Dữ liệu mình có nhiều cột,mà chiều dài của form thì có hạn,không biết bạn Sealand còn cách nào khà thi hơn không.
 
Upvote 0
Đã vậy, mình làm tổng hợp luôn. Muốn chọn đâu thì chọn (Mẹo chọn là chỉ chọn cột đầu rồi tự mở thành 5 cột)
Dòng đầu tiên bao giờ cũng là tiêu đề, muốn lấy tiêu đề cột chọn từ dòng 1

1/Code của Form (Gọn hơn là đằng khác):

Mã:
Option Explicit
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cot, Vl1, Vl2
Dim i, j, Tm()
Tm = Rng
Cancel = True
cot = InputBox("Sua dong hien thoi cot may? (1-5)")
If InStr(1, "1;2;3;4;5", cot) = 0 Then
MsgBox "Sai cot"
Exit Sub
End If
Vl2 = InputBox("Nhap gia tri can thay doi", , Tm(ListBox1.ListIndex + 1, cot))
Tm(Me.ListBox1.ListIndex + 1, cot) = Vl2
Rng = Tm
Me.ListBox1.RowSource = ""
Me.ListBox1.RowSource = Rng.Parent.Name & "!" & Rng.Address
End Sub
'------------------------------------
Private Sub UserForm_Initialize()
Dim i, Tm
Me.ListBox1.ColumnHeads = True
Me.ListBox1.RowSource = Rng.Parent.Name & "!" & Rng.Address
For i = 1 To Me.ListBox1.ColumnCount
Me.ListBox1.ColumnWidths = "80;80;80;100;90"
Next
Me.ListBox1.ListIndex = 0
End Sub
'------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set Rng = Nothing
End Sub

2/Code của Nút mở Form:

Mã:
Option Explicit
Public Rng As Range
Sub Mo()
Dim TB
Application.DisplayAlerts = False
TB = "Ban chon vung sua du lieu, neu chon duoi 5 cot Pro" & Chr(10)
TB = TB & "se tu dong mo rong them thanh 5 cot. Neu thua se cat"
On Error GoTo thoat:
Set Rng = Application.InputBox(TB, , , , , , , 8)
If Rng.Columns.Count <> 5 Then Set Rng = Rng.Columns(1).Resize(, 5)
MsgBox "Ban chon vung: " & Rng.Address & " tren sheet: " & Rng.Parent.Name
UserForm1.Show
Application.DisplayAlerts = True
Exit Sub
thoat:
Set Rng = Nothing
MsgBox "Ban khong chon hay chon loi vung sua"
Application.DisplayAlerts = True
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Đã vậy, mình làm tổng hợp luôn. Muốn chọn đâu thì chọn (Mẹo chọn là chỉ chọn cột đầu rồi tự mở thành 5 cột)
Dòng đầu tiên bao giờ cũng là tiêu đề, muốn lấy tiêu đề cột chọn từ dòng 1

1/Code của Form (Gọn hơn là đằng khác):

Mã:
Option Explicit
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cot, Vl1, Vl2
Dim i, j, Tm()
Tm = Rng
Cancel = True
cot = InputBox("Sua dong hien thoi cot may? (1-5)")
If InStr(1, "1;2;3;4;5", cot) = 0 Then
MsgBox "Sai cot"
Exit Sub
End If
Vl2 = InputBox("Nhap gia tri can thay doi", , Tm(ListBox1.ListIndex + 1, cot))
Tm(Me.ListBox1.ListIndex + 1, cot) = Vl2
Rng = Tm
Me.ListBox1.RowSource = ""
Me.ListBox1.RowSource = Rng.Parent.Name & "!" & Rng.Address
End Sub
'------------------------------------
Private Sub UserForm_Initialize()
Dim i, Tm
Me.ListBox1.ColumnHeads = True
Me.ListBox1.RowSource = Rng.Parent.Name & "!" & Rng.Address
For i = 1 To Me.ListBox1.ColumnCount
Me.ListBox1.ColumnWidths = "80;80;80;100;90"
Next
Me.ListBox1.ListIndex = 0
End Sub
'------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set Rng = Nothing
End Sub

2/Code của Nút mở Form:

Mã:
Option Explicit
Public Rng As Range
Sub Mo()
Dim TB
Application.DisplayAlerts = False
TB = "Ban chon vung sua du lieu, neu chon duoi 5 cot Pro" & Chr(10)
TB = TB & "se tu dong mo rong them thanh 5 cot. Neu thua se cat"
On Error GoTo thoat:
Set Rng = Application.InputBox(TB, , , , , , , 8)
If Rng.Columns.Count <> 5 Then Set Rng = Rng.Columns(1).Resize(, 5)
MsgBox "Ban chon vung: " & Rng.Address & " tren sheet: " & Rng.Parent.Name
UserForm1.Show
Application.DisplayAlerts = True
Exit Sub
thoat:
Set Rng = Nothing
MsgBox "Ban khong chon hay chon loi vung sua"
Application.DisplayAlerts = True
End Sub
Bạn Sealand xem lại giúp mình với,mình đánh số vào rồi mà nó không hoạt động gì cả.
 
Upvote 0
Bạn đánh số vào đâu? Khi hộp input đầu tiên hiện ra bạn dùng chuột để quét các cột chọn mà (Nếu gõ phải chính xác và có tên sheet. Sau đó mới trở lại bình thường mà.
 
Upvote 0
Chào bạn sealand,nhờ bạn giúp mình sửa lại cái form trên để cho nó chỉ hiện thị và sửa những cột mình cần,ví dụ:chi hiển và sửa cột 2,3,9,58 đến 68.tức là trong listbox có thể cho hiện đầy đủ các cột từ 1 đến 68 cũng được,còn các textbox thì chỉ hiện các cột cần sửa,cảm ơn bạn nhiều.
 
Upvote 0
Sửa trưc tiếp thì không được. Tốt nhất là ta liên kết ra textbox. KhanHa Tham khao nha
Bạn Sealand ơi,Trong bài #68 có thể tính toán trong TextBox được không,Ví dụ Cot4 bằng Cot3 + Cot2 .
Và Cot5 bằng Cot1 - Cot4 .Cảm ơn bạn.
 
Upvote 0
Hoàn toàn được, chả có gì khó khăn cả
 
Upvote 0
Mình đã làm theo cách của bạn,trong bài "Hỏi về Code trong UserForm" nhưng nó không hoạt động,Nhờ bạn làm giúp mình với.cảm ơn bạn.
 
Upvote 0
Mình đã làm theo cách của bạn,trong bài "Hỏi về Code trong UserForm" nhưng nó không hoạt động,Nhờ bạn làm giúp mình với.cảm ơn bạn.
Thì bạn cứ dùng vòng lập For... Next bình thường duyệt qua các dòng trong ListBox ---> Muốn cộng trừ gì mà chẳng được (y chang như làm trên bảng tính)
 
Upvote 0
Bạn ấy cần tính mấy cái textbox lại càng đơn giản nữa.
 
Upvote 0

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

Back
Top Bottom