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

Liên hệ QC
M

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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
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!
Nhấp chuột vào đây để mở rộng...
Để 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
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
Nhấp chuột vào đây để mở rộng...

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
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?
Nhấp chuột vào đây để mở rộng...
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?
Nhấp chuột vào đây để mở rộng...
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
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 ạ.
Nhấp chuột vào đây để mở rộng...

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

  • HOC_3_LISTVIEW.xls
    64 KB · Đọc: 60
Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
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
Nhấp chuột vào đây để mở rộng...
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

  • KhanHa.xls
    49 KB · Đọc: 70
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

  • KhanHa1.xls
    42.5 KB · Đọc: 66
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
khamha đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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
khamha đã viết:
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)
Nhấp chuột vào đây để mở rộng...

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
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.
Nhấp chuột vào đây để mở rộng...
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.
 
Upvote 0
khamha đã viết:
Chà,Mình dùng Win 7,khi vào Properties xong thì không thấy mục Appearance ở đâu cả.
Nhấp chuột vào đây để mở rộng...

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
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!
Nhấp chuột vào đây để mở rộ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
khamha đã viết:
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)
Nhấp chuột vào đây để mở rộ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ì
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
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
Nhấp chuột vào đây để mở rộng...

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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
11
Đọc
229
tle2003
T
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
25
Đọc
548
tle2003
T
vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
78
BuiQuangThuan
B
V
Hỗ trợ hàm Sumproduct và Subtotal trong GG Sheets
Trả lời
3
Đọc
230
ngocphuongchip123
ngocphuongchip123
K
Tính tổng có điều kiện
Trả lời
4
Đọc
159
kimson_nb
K
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom