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

msc0506 · 8/10/08

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 Xanh · 26/4/11

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!

ndu96081631 · 26/4/11

Learning_Excel đã viết:
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

Ếch Xanh · 26/4/11

ndu96081631 đã viết:
Để 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?

ndu96081631 · 26/4/11

Learning_Excel đã viết:
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

Learning_Excel đã viết:
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

Hoàng Trọng Nghĩa · 20/9/11

Learning_Excel đã viết:

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

ndu96081631 · 20/9/11

minhthien321 đã viết:
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

khamha · 13/10/11

msc0506 đã viết:
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.

sealand · 13/10/11

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

sealand · 13/10/11

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.

khamha · 13/10/11

sealand đã viết:
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

Cảm ơn bạn Sealand đã giúp,Theo khamha thử thì không hiểu tại sao Font lào lại không hiện được trong Form sửa (nó hiện toàn ô vuông) mình vào định định dạng lại Font lào,nhưng không thấy cái Form đó (Chắc cái Form đó không phải là Form tự tạo)
Theo mình thì nên thêm một cái Form sửa dữ liệu bằng Form tự tạo thì chắc sẽ định dạng chữ lào được (bạn làm giúp mình nhé)
Trong Form chọn cột,nếu mà thay được bằng một cái ListBox để chọn tiêu đề cột thì tiện biết mấy.Một lần nữa cảm ơn bạn.

Hoàng Trọng Nghĩa · 13/10/11

khamha đã viết:
Cảm ơn bạn Sealand đã giúp,Theo khamha thử thì không hiểu tại sao Font lào lại không hiện được trong Form sửa (nó hiện toàn ô vuông) mình vào định định dạng lại Font lào,nhưng không thấy cái Form đó (Chắc cái Form đó không phải là Form tự tạo)
Theo mình thì nên thêm một cái Form sửa dữ liệu bằng Form tự tạo thì chắc sẽ định dạng chữ lào được (bạn làm giúp mình nhé)
Trong Form chọn cột,nếu mà thay được bằng một cái ListBox để chọn tiêu đề cột thì tiện biết mấy.Một lần nữa cảm ơn bạn.

Vậy bạn vui lòng gửi File có cái Form font tiếng Lào đó lên đi nhé!

khamha · 13/10/11

minhthien321 đã viết:
Vậy bạn vui lòng gửi File có cái Form font tiếng Lào đó lên đi nhé!

File đây bạn.Mà XP không đọc được đâu (Chỉ có Vista và win 7 mới hiện được chữ lào)

Hoàng Trọng Nghĩa · 13/10/11

khamha đã viết:
File đây bạn.Mà XP không đọc được đâu (Chỉ có Vista và win 7 mới hiện được chữ là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.

khamha · 13/10/11

minhthien321 đã viết:
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.

Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.

Hoàng Trọng Nghĩa · 13/10/11

khamha đã viết:
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.

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!

Hoàng Trọng Nghĩa · 13/10/11

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!

khamha · 13/10/11

minhthien321 đã viết:
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!

Cảm ơn bạn,mình chỉnh lại như hướng dẫn nhưng vẫn không có gì thay đổi,chữ lào nếu hiên trên cái Form sửa vẫn là: ??????? (dấu hỏi)

ndu96081631 · 13/10/11

khamha đã viết:
File đây bạn.Mà XP không đọc được đâu (Chỉ có Vista và win 7 mới hiện được chữ là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:

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

Hoàng Trọng Nghĩa · 13/10/11

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

Hoàng Trọng Nghĩa · 13/10/11

ndu96081631 đã viết:
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.

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

Thành viên chính thức

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

Huyền thoại GPE

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

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Huyền thoại GPE

Không có việc gì khó...

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

File đính kèm

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

File đính kèm

Không có việc gì khó...

Chuyên gia GPE

Không có việc gì khó...

File đính kèm

Chuyên gia GPE

Không có việc gì khó...

Chuyên gia GPE

Chuyên gia GPE

Không có việc gì khó...

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

Đếm ngược thời gian