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
    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           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 WithMe.H_LV.ListItems.Remove (i)

Xem tạm cái này nhé (dù không hay cho lắm)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.




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 SubNhư 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 hayTheo 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:
Đồ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ùngMã: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
Private mobjFromList As MSForms.ListBox
Private mlFrom As LongPrivate Sub UserForm_Initialize()
  Dim i As Long
  For i = 0 To 50
    Me.ListBox1.AddItem "Item " & i
  Next
End SubPrivate 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 SubPrivate 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 SubPrivate 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 SubXem tạm cái này nhé (dù không hay cho lắm)
http://www.xtremevbtalk.com/showthread.php?t=299439
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 SubTheo 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:
Đồ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ùngMã: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
Trời ơi... thì áp code của anh sealand vào là xong mà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.
Private Sub Listview1_DblClick()
  ListViewMoveToTop ListView1
  ListView1.ListItems(1).EnsureVisible
End SubPrivate Sub UserForm_Initialize()
  Dim i As Long
  ListView1.ColumnHeaders.Add , , "", 100
  For i = 1 To 20
    ListView1.ListItems.Add , , "Item" & i
  Next
End SubPrivate 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 SubBạn nói cuộn thế nào tôi chưa hiểuThậ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?
Thì cái mà anh sealand đã làm ấy, chẳng đúng thế sao?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)


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... NextXin 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).
Private Sub CommandButton1_Click()
  Dim lsvItem As ListItem
  For Each lsvItem In Me.ListView1.ListItems
    lsvItem.Checked = True
  Next
End Sub



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

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
tiếp tục For next!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ì RemoveDạ, 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?!
  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





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

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
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 SubXó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ỉ?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.


Đú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.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ỉ?
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



Em nghĩ đâu cần thiết phải thêm cột hả anh!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)
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 SubPrivate 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 SubPrivate 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



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)
Ai lại làm thế!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
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

listview nó có phương thức sort, vậy mà dựa vào index thì dễ oan gia lắm.
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 SubPrivate Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  Call ListViewSort(ListView1, ColumnHeader)
End SubThật ra cũng chẳng hề gì nếu bạn... khéoĐã 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 SubNhư 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".PHP:Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) Call ListViewSort(ListView1, ColumnHeader) End Sub


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



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...
Tra Dictionary và lấy Index là y chang nhau mà anh..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.


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 SubPrivate 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 SubPrivate Sub XoaDongTrong()
  On Error Resume Next
  With Sheet1.UsedRange
    .SpecialCells(2).EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .EntireRow.Hidden = False
  End With
End SubPrivate Sub XoaDongTrong()
   On Error Resume Next
   Sheet1.UsedRange.SpecialCells(4).EntireRow.Delete
End Sub

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 SubTrờ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ụ: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
Dim SrcRng as Range
Private Sub UserForm_Initialize()
  Set SrcRng = Sheet1.Range([A2], Sheet1.[B65536].End(xlUp))
  .......
End SubPrivate Sub UserForm_Terminate()
  SrcRng.SpecialCells(4).Delete 2
End Sub  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  For i = 1 To UBound(Arr())
     If Arr(i, 1) & Arr(i, 2) <> "" Then      s = s + 1
      For j = 1 To 2
        ArrKQ(s, j) = Arr(i, j)
      Next     s = s + 1
      ArrKQ(s, 1) = Arr(i, 1): ArrKQ(s, 2) = Arr(i, 2)

Private Sub XoaDongTrong()
   On Error Resume Next
   Set Rng = Range(Sheet1.[A2], Sheet1.[B65535].End(xlUp))
   Rng.SpecialCells(4).Delete 2
End SubThì đoạn này .Resize(j, 2) = ArrKQ nó gán Value xuống sheet, lấy đâu mà còn công thứcCò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


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)
...
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Đưa file có công thức lên đây đi chứ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!


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



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

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


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ó)
- 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?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 ạ.




1. For thừa:
Tại sao không làm vầy: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
Khỏi biến dk, khỏi dùng 100 vòng lặp conPHP:For i = 1 To UBound(Arr()) If Arr(i, 1) & Arr(i, 2) <> "" Then
2. Còn cái này:
sao không phải là:PHP:s = s + 1 For j = 1 To 2 ArrKQ(s, j) = Arr(i, j) Next
3. Khai báo ArrKQ thừa kích thước:PHP:s = s + 1 ArrKQ(s, 1) = Arr(i, 1): ArrKQ(s, 2) = Arr(i, 2)
Đã 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!


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 SubPrivate 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 SubXé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ở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 SubPHP: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
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 SubFunction 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 FunctionSub Main()
  With Sheet1.UsedRange
    .Value = RemoveBlanksRow(.Cells)
  End With
End Sub

Để 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ả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!
Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcRng As Range[/B][/COLOR])Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcArray As Variant[/B][/COLOR])

Để 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:
ThànhMã:Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcRng As Range[/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 nhaMã:Function RemoveBlanksRow(ByVal [COLOR=red][B]SrcArray As Variant[/B][/COLOR])
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àoThì mình quy định trong Module là Option Base 0 là được rồi phải không thưa Thầy?
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ợpCò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?
Sub Main()
    With Sheet1.Range("A:L")
       .Value = RemoveBlanksRow(.Cells)
    End With
End SubĐể 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 ạ.
Thì For next thôi, có gì đâuMượ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.
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 SubPrivate 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 Subchà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.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




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 SubCả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)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.
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)
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.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ả.
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 SubCả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)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!
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ì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)

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 SubLạ 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
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.
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.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.
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.Để 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.




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 SubOption 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 SubBạ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ả.Đã 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 ơi,Trong bài #68 có thể tính toán trong TextBox được không,Ví dụ Cot4 bằng Cot3 + Cot2 .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
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)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.
