Code chuyển hàng bất kỳ lên hàng thứ 3

[khamha]

Nhờ các bạn giúp,Như chủ đề mình đã nêu ở trên,Ý của mình là:
khi ta chọn số TT từ hàng thứ tư trở xuống tại ô B1 thì tất cả dữ liệu có trong hàng đó sẽ được
chuyển lên hàng thứ 3,Các bạn xem File đính kèm.Cảm ơn

 

[Hoàng Trọng Nghĩa]

Mình định sử dụng cái Form này để sửa dữ liệu trong Sheet"Data",Có các cột cần phải nhập dữ liệu theo quy định sẵn ( chỉ cho nhập dữ liệu có trong List)Khi đưa vào sử dụng thì sẽ có 32 cột,cột sử dụng comboBox là cột 2,3,7,10 và 28.

Má ơi, cột nhiều dữ vậy à? Sao không làm hẳn trên sheet luôn đi trời!

Nói thì nói vậy, bạn gửi 1 cái File có cấu trúc như bạn mô tả đi, tôi sẽ thử làm cho bạn.

 

[khamha]

Má ơi, cột nhiều dữ vậy à? Sao không làm hẳn trên sheet luôn đi trời!

Nói thì nói vậy, bạn gửi 1 cái File có cấu trúc như bạn mô tả đi, tôi sẽ thử làm cho bạn.

Cảm ơn bạn,bạn chỉ cần làm ví dụ trong file cũ,để mình còn làm thêm để rút kinh nghiệm.

 

[Hoàng Trọng Nghĩa]

Mình định sử dụng cái Form này để sửa dữ liệu trong Sheet"Data",Có các cột cần phải nhập dữ liệu theo quy định sẵn ( chỉ cho nhập dữ liệu có trong List)Khi đưa vào sử dụng thì sẽ có 32 cột,cột sử dụng comboBox là cột 2,3,7,10 và 28.

Cái này nếu vậy thì tôi sẽ thêm 3 cái Combobox thay thế cho 3 cái Textbox trong File đó, chỉ thêm 1 vòng lặp để duyệt tìm Control nữa thôi:

Dim MyRange As Range, MyMsgbox As Integer, MyControl As Control, i As Long


Private Sub UserForm_Initialize()
    ListBox1.List = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7).Value
End Sub


Private Sub CommandButton1_Click()
    MyMsgbox = MsgBox("Ban co chac luu lai chinh sua thong tin cua ID: " & TextBox1, vbYesNo + vbQuestion, "Thông Báo")
    If MyMsgbox = vbYes Then
        Set MyRange = Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp)).Find(Label6.Caption, LookIn:=xlValues, LookAt:=xlWhole)
            For Each MyControl In Controls
                If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
                    For i = 0 To 6
                        If Right(MyControl.Name, 1) = i + 1 Then MyRange.Offset(, i) = MyControl.Text
                    Next
                End If
            Next
        ListBox1.List = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7).Value
    End If
    CommandButton1.Enabled = False
    CommandButton2.Enabled = True
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MyMsgbox = MsgBox("Ban co chac chinh sua thong tin cua ID: " & ListBox1.Value, vbYesNo + vbQuestion, "Thông Báo")
    If MyMsgbox = vbYes Then
        For Each MyControl In Controls
            If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
                For i = 0 To 6
                    If Right(MyControl.Name, 1) = i + 1 Then MyControl.Text = ListBox1.Column(i)
                Next
            End If
        Next
        Label6.Caption = ListBox1.Value
        CommandButton1.Enabled = True
        CommandButton2.Enabled = False
        ListBox1.List = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7).Value
    End If
End Sub


Private Sub CommandButton2_Click()
    Set MyRange = Sheet1.[A65536].End(xlUp).Offset(1)
        For Each MyControl In Controls
            If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
                For i = 0 To 6
                    If Right(MyControl.Name, 1) = i + 1 Then MyRange.Offset(, i) = MyControl.Text
                Next
            End If
        Next
    ListBox1.List = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7).Value
End Sub

Xem File nhé bạn!

 

[khamha]

Nhờ bạn minhthien321 làm cho cái listbox nó: có thể cuộn lên xuống bằng bánh xe chuột , và mình muốn sau khi nhập dữ liệu đã sửa thì danh sách trong listbox nó đứng yên,chứ đừng chạy về hàng đầu.vì rất bất tiện nếu ta sửa dữ liệu ở các hàng dưới cùng.cảm ơn bạn.

 

[Hoàng Trọng Nghĩa]

Nhờ bạn minhthien321 làm cho cái listbox nó: có thể cuộn lên xuống bằng bánh xe chuột , và mình muốn sau khi nhập dữ liệu đã sửa thì danh sách trong listbox nó đứng yên,chứ đừng chạy về hàng đầu.vì rất bất tiện nếu ta sửa dữ liệu ở các hàng dưới cùng.cảm ơn bạn.

Xin thưa với bạn là không thể, bởi ListBox không được tích hợp scroll chuột lăn, nếu bạn muốn điều đó thì chỉ có ListView.

 

[khamha]

Còn vấn đề thứ 2 thì sao bạn.

 

[Hoàng Trọng Nghĩa]

Còn vấn đề thứ 2 thì sao bạn.

Cái này cũng không khó lắm, chẳng qua là mình update dữ liệu thôi, giờ mình phải về rồi, nếu mai mà chưa ai trả lời cho bạn thì mình sẽ hướng dẫn cho bạn nhé! Chúc vui.

 

[sealand]

Sao các bạn lại không sử dụng thuộc tính của Listbox nhỉ. Nó không hỗ trợ chuột lăn nhưng nó hỗ trợ 1 cách theo mình còn nhanh hơn nhiều. Đó là:

TopIndex
ListIndex

Ngay trên Form của bạn bạn thên 2 commandbutton
CommandButton1 (Caption="Tim dong")
CommandButton2 (Caption="Tim Noi dung")
rồi nhập code sau

Private Sub CommandButton1_Click()
Dim i
i = InputBox("Nhap dong can tim")
Me.ListBox1.ListIndex = i
Me.ListBox1.TopIndex = i
End Sub

Và code cho nút 2:

Private Sub CommandButton2_Click()
 Dim i As Long, Ch_tim As String
  Ch_tim = InputBox("Nhap chuoi can tim")
    If Len(Ch_tim) = 0 Then
      Me.ListBox1.ListIndex = -1
       Me.ListBox1.TopIndex = 0
         Else
           For i = 0 To Me.ListBox1.ListCount - 1
            If UCase(Left(Me.ListBox1.List(i), _
            Len(Ch_tim))) = UCase(Ch_tim) Then
             Me.ListBox1.TopIndex = i
            Me.ListBox1.ListIndex = i
          Exit For
        End If
     Next i
    End If
End Sub

Rồi giờ mở Form lên:
-Nhấn nút 1 rồi nhập 1 dòng nào đó khuất nẻo tận đâu đó rồi OK xem nó có mang về dòng đầu tiên trên List không.
-Nhấn nút 2 rồi nhập 1 vài ký tự đầu của dòng nào trên cột 1 (Ví du: sea nếu trong list có Item SEALND001 chẳng hạn) rồi OK xem nó có mang về dòng đầu tiên trên List không.

Chúc bạn vừa ý

 

[Hoàng Trọng Nghĩa]

Như hôm qua đã nói, tôi sử dụng thủ tục dưới đây để cập nhật dữ liệu cho Listbox:

ListBox1.List = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7).Value

Vì thế, khi nhập mới hoặc chỉnh sửa sẽ bị cập nhật toàn bộ mới nên có hiện tượng form bị chớp và trả về hàng đầu tiên (dĩ nhiên nếu dữ liệu lớn sẽ bị chậm), để khắc phục điều đó, ta chỉ cần chỉnh sửa đúng hàng đó và cập nhật cũng chỉ hàng đó thôi mà không cần phải toàn bộ giá trị, nó vừa không mất thời gian mà đúng theo theo yêu cầu của bạn là không chạy hàng về từ đầu trong ListBox. Với nhập mới cũng vậy, ta chỉ cập nhật dòng cuối cùng của ListBox.

1) Nhập giá trị vào ListBox:

Private Sub UserForm_Initialize()
    Set MyRange = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
    If MyRange.Row = 1 Then Exit Sub [COLOR=#008000]'<--Dùng để bẫy lỗi nếu không có giá trị nào trong cơ sở dữ liệu[/COLOR]
    ListBox1.List = MyRange.Value
End Sub

2) Nhập giá trị mới:

Private Sub CommandButton2_Click()
    Dim MyRow As Long
    Set MyRange = Sheet1.[A65536].End(xlUp).Offset(1)
    [COLOR=#ff0000]ListBox1.AddItem
    MyRow = ListBox1.ListCount - 1[/COLOR]
    For Each MyControl In Controls
        If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
            For MyColumn = 0 To 6
                If Right(MyControl.Name, 1) = MyColumn + 1 Then
                    MyRange.Offset(, MyColumn) = MyControl.Text
                    [COLOR=#ff0000]ListBox1.List(MyRow, MyColumn) = MyControl.Text[/COLOR]
                End If
            Next
        End If
    Next
    [B][COLOR=#0000cd]ListBox1.ListIndex = MyRow[/COLOR][/B]
End Sub

Với các dòng màu đỏ là thủ tục thêm vào dòng cuối cùng của ListBox mà không phải cập nhật toàn bộ cho Listbox. Với dòng xanh là thủ tục di chuyển đến hàng cuối cùng khi bạn nhập mới.

3) Thủ tục chỉnh sửa:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo ExitSub '(Bẫy lỗi khi không có giá trị nào trong ListBox)
    MyListItem = ListBox1.Value: MyListIndex = ListBox1.ListIndex
    MyMsgbox = MsgBox("Bạn sẽ làm gì với thông tin của ID: " & ListBox1.Value & Chr(10) & Chr(10) & _
                      "- Nếu chọn YES, bạn sẽ chỉnh sửa mục này." & Chr(10) & Chr(10) & _
                      "- Nếu chọn NO, bạn sẽ xoá mục này." & Chr(10) & Chr(10) & _
                      "- Nếu chọn CANCEL, bạn sẽ thoát thông báo này", vbYesNoCancel + vbQuestion, "Thông Báo")
    If MyMsgbox = vbYes Then
        For Each MyControl In Controls
            If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
                For MyColumn = 0 To 6
                    If Right(MyControl.Name, 1) = MyColumn + 1 Then MyControl.Text = ListBox1.Column(MyColumn)
                Next
            End If
        Next
        CommandButton1.Enabled = True: CommandButton2.Enabled = False
    ElseIf MyMsgbox = vbNo Then
        ListBox1.RemoveItem MyListIndex
[COLOR=#008000]'Dùng cách nào để xóa hàng trong sheet cũng được nếu bạn thấy thuận tiện:
'Cách 1: (Nếu chắc chắn ID không bị trùng - Với cách này thuận tiện nếu Listbox có sử dụng thuộc tính SORT)
       [/COLOR][COLOR=#0000cd] 'Set MyRange = Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp)).Find(MyListItem, LookIn:=xlValues, LookAt:=xlWhole)
        'If Not MyRange Is Nothing Then MyRange.Resize(, 7).Delete 2[/COLOR][COLOR=#008000]
'Cách 2: (Ngắn gọn, không dùng Find Method, nhưng hãy coi chừng nếu ListBox bị SORT mà CSDL không thay đổi theo ListBox sẽ bị xóa sai)[/COLOR]
        [COLOR=#ff0000]Sheet1.Range("A" & MyListIndex + 2).Resize(, 7).Delete 2[/COLOR]
    End If
ExitSub:
End Sub

Với thủ tục trên, tôi đã thêm cho bạn phần xóa Record trong ListBox cũng như trong CSDL, điều này rất cần khi thao tác trên Form.

4) Thủ tục nhập chỉnh sửa:

Private Sub CommandButton1_Click()
    MyMsgbox = MsgBox("Ban co chac luu lai chinh sua thong tin cua ID: " & TextBox1, vbYesNo + vbQuestion, "Thông Báo")
    If MyMsgbox = vbYes Then
        Set MyRange = Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp)).Find(MyListItem, LookIn:=xlValues, LookAt:=xlWhole)
        For Each MyControl In Controls
            If TypeName(MyControl) = "TextBox" Or TypeName(MyControl) = "ComboBox" Then
                For MyColumn = 0 To 6
                    If Right(MyControl.Name, 1) = MyColumn + 1 Then
                        MyRange.Offset(, MyColumn) = MyControl.Text
                        [COLOR=#ff0000][B]ListBox1.List(MyListIndex, MyColumn) = MyControl.Text[/B][/COLOR]
                    End If
                Next
            End If
        Next
    End If
    CommandButton1.Enabled = False: CommandButton2.Enabled = True
End Sub

Với dòng màu đỏ, là cập nhật chỉnh sửa tại chỗ, không phải cập nhật toàn bộ ListBox, nên sẽ không bị chớp chớp và trở về dòng đầu tiên.

Hy vọng bạn vừa ý với những thủ tục trên.

 

[khamha]

Không biết tại sao khi thêm cột (có sửa lại code,thêm textbox và combobox)mà nó lại không hoạt động.bạn giúp mình với,cảm ơn bạn.

 

[khamha]

khi chỉnh sửa lại Code,hình như chỉ thêm được hai textbox hoặc combobox,đúng là không hiểu nổi.