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 With
Me.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 Sub
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 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 Long
Private Sub UserForm_Initialize()
Dim i As Long
For i = 0 To 50
Me.ListBox1.AddItem "Item " & i
Next
End Sub
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
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
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
Xem 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 Sub
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:
Đồ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 Sub
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
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
Bạ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 Sub
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ỉ?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 Sub
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
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
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 Sub
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Đã 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
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".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 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).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 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).Clear '<--- thay cho Delete
.ListItems.Remove i
End If
Next
End With
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
Private 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 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ụ: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 Sub
Private 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 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ứ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 Sub
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
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
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 Sub
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ở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
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
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
Sub 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 Sub
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
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.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 Sub
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)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 Sub
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)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 Sub
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
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 Sub
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ả.Đã 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.