Insert dòng và điền dữ liệu sau khi lọc bằng hàm Filter2Darray (1 người xem)

[vanhesing]

Xin chào mọi người !
Tôi có 1 ví dụ về hàm Filter2Darray cho việc insert và điền dữ liệu , mong mọi người xem qua và giúp đỡ
Trong file tôi gửi có dùng hàm Filter2Darray của thầy NDU.hàm này ngoài việc lọc theo 2 điều kiện tôi muốn tìm hiểu xem có insert và điền dữ liệu cho dòng đã insert hay không.Nếu sử dụng hàm Find thì tôi làm được khi không lọc bằng Filter2Darray nhưng sau khi lọc thì không được.Vậy nếu dùng Filter2Darray có insert và điền dữ liệu vào dòng vừa insert trước và sau khi lọc và được hay không ?tôi đã mày mò tìm hiểu nhưng vẫn không tìm được hướng.
Trong file mình dùng hàm Filter2Darray để chỉnh sữa dữ liệu.giờ mong muốn mọi người giúp và giải thích giùm việc insert bằng Filter2Darray.
Mong mọi người giúp đỡ.Chân thành cảm ơn
=http://quanaososinh.vn/quan-ao-tre-em/quan-ao-so-sinh

 

[vanhesing]

Tôi thấy không ai trả lời, Như vậy có lẻ như tôi nghĩ hàm Filter2Darray chỉ có chức năng lọc 2 dk chứ không vận dụng bổ sung thêm được insert.
Thanks
=http://quanaososinh.vn/quan-ao-tre-em/quan-ao-so-sinh

 

[ndu96081631]

Tôi thấy không ai trả lời, Như vậy có lẻ như tôi nghĩ hàm Filter2Darray chỉ có chức năng lọc 2 dk chứ không vận dụng bổ sung thêm được insert.
Thanks

Có hiểu bạn nói gì đâu mà giúp! Insert là làm cái gì? Insert cái gì vào đâu?

 

[vanhesing]

Dear thầy NDU !
Ý tôi thay vì chọn 1 dòng trên listbox để chỉnh sữa dòng đó , nhưng giờ không sữa mà insert 1 dòng trống phía dưới listindex và điền dữ liệu mới vào dòng trống đó .
Cảm ơn đã hỏi

 

[Hoàng Trọng Nghĩa]

Dear thầy NDU !
Ý tôi thay vì chọn 1 dòng trên listbox để chỉnh sữa dòng đó , nhưng giờ không sữa mà insert 1 dòng trống phía dưới listindex và điền dữ liệu mới vào dòng trống đó .
Cảm ơn đã hỏi

Để thêm dòng (hàng cuối), bạn dùng lệnh này:

ListBox1.AddItem

Nếu vừa muốn thêm dòng và lại muốn chép gì đó vào dòng đó thì:

    With ListBox1
        .AddItem
        .List(.ListCount - 1, [COLOR=#ff0000]0[/COLOR]) = "Nghia"
        .List(.ListCount - 1, [COLOR=#ff0000]1[/COLOR]) = "Dep"
        .List(.ListCount - 1, [COLOR=#ff0000]2[/COLOR]) = "Trai"
    End With

Với 0, 1, 2 tương ứng với cột 1, 2, 3 của listbox.

 

[vanhesing]

Dear thầy NDU !
Ý tôi thay vì chọn 1 dòng trên listbox để chỉnh sữa dòng đó , nhưng giờ không sữa mà insert 1 dòng trống phía dưới listindex và điền dữ liệu mới vào dòng trống đó .
Cảm ơn đã hỏi

 

[vanhesing]

Để thêm dòng (hàng cuối), bạn dùng lệnh này:

ListBox1.AddItem

Nếu vừa muốn thêm dòng và lại muốn chép gì đó vào dòng đó thì:

    With ListBox1
        .AddItem
        .List(.ListCount - 1, [COLOR=#ff0000]0[/COLOR]) = "Nghia"
        .List(.ListCount - 1, [COLOR=#ff0000]1[/COLOR]) = "Dep"
        .List(.ListCount - 1, [COLOR=#ff0000]2[/COLOR]) = "Trai"
    End With

Với 0, 1, 2 tương ứng với cột 1, 2, 3 của listbox.

Dear Anh Nghĩa đẹp trai !
Cảm ơn Anh . nhưng chưa đúng ý tôi .
Tôi đã thêm một button dùng hàm find biến tấu lại theo hiểu biết ít ỏi . giờ thì lại đúng cho cả 2 trường hợp lọc và không lọc .
Nhờ Anh xem và cho ý kiến

  Dim fRng As Range, Rng As Range, i As Long, n As Long
  Set fRng = Sheet1.Range("A:A").Find(ListBox1, , xlValues, xlWhole)
   If Not fRng Is Nothing Then
  fRng(2).EntireRow.Insert
      Set Rng = fRng.Offset(1)
   For i = 1 To 12
With Me
Rng.Offset(, i).Value = .Controls("combobox"

 

[Hoàng Trọng Nghĩa]

Dear Anh Nghĩa đẹp trai !
Cảm ơn Anh . nhưng chưa đúng ý tôi .
Tôi đã thêm một button dùng hàm find biến tấu lại theo hiểu biết ít ỏi . giờ thì lại đúng cho cả 2 trường hợp lọc và không lọc .
Nhờ Anh xem và cho ý kiến

  Dim fRng As Range, Rng As Range, i As Long, n As Long
  Set fRng = Sheet1.Range("A:A").Find(ListBox1, , xlValues, xlWhole)
   If Not fRng Is Nothing Then
  fRng(2).EntireRow.Insert
      Set Rng = fRng.Offset(1)
   For i = 1 To 12
With Me
Rng.Offset(, i).Value = .Controls("combobox" & i)
End With
Next
   End If
       nap

Do lười nhập lại dữ liệu mới nên mượn dòng dữ liệu cũ để điền vào ô rỗng luôn.
Nhờ Anh giúp cho tôi phần set lại số thứ tự mỗi khi chèn dòng.
Cảm ơn Anh Nghĩa đẹp trai

Bạn muốn Insert cái gì? Trong sheet hàng cuối?

Còn dòng lệnh này, bạn muốn tìm cái gì vậy?

Set fRng = Sheet1.Range("A:A").Find(ListBox1, , xlValues, xlWhole)

Trong ListBox1 có vô số dữ liệu, nó hiểu như thế nào mà Find?

 

[vanhesing]

Bạn muốn Insert cái gì? Trong sheet hàng cuối?

Tôi ví dụ thế này :
Tôi có 4 dòng dữ liệu
1.A
2.B
3.D
4.E
Một ngày đẹp trời, tôi muốn thêm 1 dòng dữ liệu vào giữa dòng 2 và dòng 3(dưói dòng 2 trên dòng 3),kết quả sẽ như vầy:
1 .A
2 .B
.C (dòng được thêm vào)
3 .D
4 .E
Tôi không hề muốn insert trong sheet dòng cuối, có lẻ tôi chưa trình bày rõ ràng khiến Anh hiểu sai.

Còn dòng lệnh này, bạn muốn tìm cái gì vậy?
Set fRng = Sheet1.Range("A:A").Find(ListBox1, , xlValues, xlWhole)
Trong ListBox1 có vô số dữ liệu, nó hiểu như thế nào mà Find?

-Dòng lệnh này mục đích là xác định dòng mà tôi muốn insert dưới nó trong range.như ví dụ ở trên thì tôi sẽ chọn listindex ở dòng số 2 trong listbox1.
-Đúng là trong listbox có vô số dữ liệu , nếu không rõ ràng điều kiện cần find thì nó sẽ tự find cột đầu tiên của listbox nên tôi set fRng = Sheet1.Range("A:A").
Bây giờ tôi muốn find cột khác thì tôi sẽ sữa lại như sau :

Set fRng = Sheet1.Range("e:e").Find(ListBox1.Column(4), , xlValues, xlWhole)

Còn dòng này thì bị thừa
If Not fRng Is Nothing Then
Thanks

 

[Hoàng Trọng Nghĩa]

Tôi ví dụ thế này :
Tôi có 4 dòng dữ liệu
1.A
2.B
3.D
4.E
Một ngày đẹp trời, tôi muốn thêm 1 dòng dữ liệu vào giữa dòng 2 và dòng 3(dưói dòng 2 trên dòng 3),kết quả sẽ như vầy:
1 .A
2 .B
.C (dòng được thêm vào)
3 .D
4 .E
Tôi không hề muốn insert trong sheet dòng cuối, có lẻ tôi chưa trình bày rõ ràng khiến Anh hiểu sai.

-Dòng lệnh này mục đích là xác định dòng mà tôi muốn insert dưới nó trong range.như ví dụ ở trên thì tôi sẽ chọn listindex ở dòng số 2 trong listbox1.
-Đúng là trong listbox có vô số dữ liệu , nếu không rõ ràng điều kiện cần find thì nó sẽ tự find cột đầu tiên của listbox nên tôi set fRng = Sheet1.Range("A:A").
Bây giờ tôi muốn find cột khác thì tôi sẽ sữa lại như sau :

Set fRng = Sheet1.Range("e:e").Find(ListBox1.Column(4), , xlValues, xlWhole)

Còn dòng này thì bị thừa
If Not fRng Is Nothing Then
Thanks

Tức bạn muốn insert vào listbox mà con trỏ đang select tại đó? Trên hàng đó 1 dòng hay dưới hàng đó 1 dòng hả bạn?

Đoạn "If Not fRng Is Nothing Then" không thừa đâu bạn ơi.

 

[vanhesing]

Tức bạn muốn insert vào listbox mà con trỏ đang select tại đó? Trên hàng đó 1 dòng hay dưới hàng đó 1 dòng hả bạn?

Đoạn "If Not fRng Is Nothing Then" không thừa đâu bạn ơi.

Dưới hàng đó 1 dòng Anh ạ
"If Not fRng Is Nothing Then" không thừa.Có thể giải thích thêm cho tôi biết đoạn này có thêm ý nghĩa gì nữa hay không
Thanks

 

[Hoàng Trọng Nghĩa]

Dưới hàng đó 1 dòng Anh ạ
"If Not fRng Is Nothing Then" không thừa.Có thể giải thích thêm cho tôi biết đoạn này có thêm ý nghĩa gì nữa hay không
Thanks

Bây giờ tôi đã sửa toàn bộ code trong Form như sau:

Private Sub UserForm_Initialize()
    Call Nap
End Sub


Sub Nap()
    sArray = Range(Sheet1.Range("A12"), Sheet1.Range("M65536").End(xlUp)).Value
    ListBox1.List() = sArray
End Sub


Sub TaoSTT()
    Dim LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        .Range("A13") = 1
        .Range("A14") = 2
        .Range("A13:A14").AutoFill Destination:=.Range("A13:A" & LastRow)
    End With
End Sub


Private Sub ListBox1_Click()
    Dim c As Byte
    For c = 1 To 12
        Controls("combobox" & c) = ListBox1.List(, c)
    Next
End Sub


Private Sub cmdInsert_Click()
    Dim c As Byte, SelRow As Long
    SelRow = ListBox1.ListIndex + 13
    Sheet1.Range("A" & SelRow & ":N" & SelRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For c = 1 To 12
        Sheet1.Range("A" & SelRow).Offset(, c) = Controls("combobox" & c)
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = SelRow - 12
End Sub


Private Sub NUTNL_Click()
    Dim c As Long, LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        For c = 1 To 12
            Sheet1.Range("A" & LastRow).Offset(, c) = Controls("combobox" & c)
        Next
    End With
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Bạn kiểm tra lại xem có đúng theo ý bạn không nhé!

 

[vanhesing]

Bây giờ tôi đã sửa toàn bộ code trong Form như sau:

 Private Sub UserForm_Initialize()     Call Nap End Sub   Sub Nap()     sArray = Range(Sheet1.Range("A12"), Sheet1.Range("M65536").End(xlUp)).Value     ListBox1.List() = sArray End Sub   Sub TaoSTT()     Dim LastRow As Long     With Sheet1         LastRow = .Range("B65536").End(xlUp).Row         .Range("A13") = 1         .Range("A14") = 2         .Range("A13:A14").AutoFill Destination:=.Range("A13:A"

 

[Hoàng Trọng Nghĩa]

Cảm ơn Anh Nghĩa !
Chân thành mà nói tôi không cần đúng ý vì tôi đã làm được những vấn đề đó với code dài và thô sơ đa số vận dụng ,copy paste từ những bài tập trên diễn đàn ( có học hỏi chứ ko như vẹt .^^), mục đích chỉ là chia sẻ tìm hiểu học hỏi. Nhưng bài này Anh rất đúng ý tôi,cho tôi mở rộng việc học hỏi với code siêu ngắn và hiệu quả của anh dù anh chả đá động gì tới Filter2Darray. Tuy nhiên với đoạn này

Private Sub NUTNL_Click()
    Dim c As Long, LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        For c = 1 To 12
            Sheet1.Range("A" & LastRow).Offset(, c) = Controls("combobox" & c)
        Next
    End With
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Tôi cần nhập mới chứ không cần sữa dữ liệu dòng cuối nên tôi thêm

LastRow = LastRow + 1

Và vấn đề chính là : Code của anh làm rất tốt khi không lọc theo điều kiện là số nhà . Nhưng khi tôi cho lọc thì insert không đúng như ý tôi muốn nữa.nó insert dòng đầu tiên của lítbox.với dữ liệu 3000 dòng mà tìm dòng cần insert thì rất khó khăn.
PS :sub nạp tôi không muốn lấy tiêu đề.

Ờ tôi quên, phải cộng thêm 1 nữa:

LastRow = .Range("B65536").End(xlUp).Row + 1

Như vậy mới đúng.

 

[vanhesing]

Vậy còn vụ lọc rồi mới insert thi sao anh ?

 

[Hoàng Trọng Nghĩa]

Vậy còn vụ lọc rồi mới insert thi sao anh ?

Tôi làm luôn cho bạn nè:

Đây là code cập nhật, trong đó, tôi có lọc duy nhất số nhà cho bạn và đặt chúng trong ComboBox số nhà luôn:

Sub Nap()
    Dim Dict As Object
    Dim LastRow As Long, r As Long, u As Long
    LastRow = Sheet1.Range("C65536").End(xlUp).Row
    sArray = Sheet1.Range("A13:N" & LastRow).Value
    u = UBound(sArray)
    ''Dung de loc duy nhat so nha, gan cho combobox:
    Set Dict = CreateObject("Scripting.Dictionary")
    For r = 1 To u
        sArray(r, 14) = r + 13
        Dict(sArray(r, 3)) = sArray(r, 3)
    Next
    ListBox1.List() = sArray
    LOC.List = Dict.Keys
End Sub


Private Sub LOC_Change()
    ListBox1.List() = Filter2DArray(sArray, 3, LOC.Text & "*", False)
End Sub


Private Sub cmdInsert_Click()
    Dim c As Byte
    Dim RowIndex As Long
    RowIndex = ListBox1.List(, 13)
    Sheet1.Range("A" & RowIndex & ":N" & RowIndex).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For c = 1 To 12
        Sheet1.Range("A" & RowIndex).Offset(, c) = Controls("combobox" & c)
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - 13
End Sub

 

[vanhesing]

Tôi làm luôn cho bạn nè:

Đây là code cập nhật, trong đó, tôi có lọc duy nhất số nhà cho bạn và đặt chúng trong ComboBox số nhà luôn:

Sub Nap()
    Dim Dict As Object
    Dim LastRow As Long, r As Long, u As Long
    LastRow = Sheet1.Range("C65536").End(xlUp).Row
    sArray = Sheet1.Range("A13:N"

 

[Hoàng Trọng Nghĩa]

   Dim RowIndex As Long
    RowIndex = ListBox1.List(, 13)
    Sheet1.Range("A" & RowIndex & ":N" & RowIndex).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Nếu số cột lên đến 30 cột ??
mấy cái kia hiểu được riêng chổ này test file gốc nó nhảy lên hơn 10 dòng

Nếu cột lên đến bao nhiêu thì thay ":N" là tên của cột đó, ví dụ tới cột AD thì thay thành: ":AD"


Vấn đề nhảy lên hơn 10 dòng là ở chỗ này:

    For r = 1 To u
        sArray(r, 14) = r + [B][COLOR=#ff0000]13[/COLOR][/B]
        Dict(sArray(r, 3)) = sArray(r, 3)
    Next

Từ hàng 1 đến hàng có chứa tiêu đề (có 2 dòng) có bao nhiêu hàng thì tổng số hàng đó bạn cộng thêm 1 nữa là OK. Và như thế, nó phải thay thế nhiều thứ khác như tôi lấy mốc ở ô A13 giả sử số thứ tự đầu tiên ở ô đó, nhưng với dữ liệu của bạn ở ô A3 thì bạn phải sửa tất cả các Range có chứa A13 thành A3. Và như vậy:

sArray(r, 14) = r + 13 thành sArray(r, 14) = r + 3

Sub TaoSTT()
    Dim LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        .Range("[COLOR=#ff0000][B]A13[/B][/COLOR]") = 1
        .Range("A14") = 2
        .Range("[B][COLOR=#ff0000]A13[/COLOR][/B]:A14").AutoFill Destination:=.Range("[B][COLOR=#ff0000]A13[/COLOR][/B]:A" & LastRow)
    End With
End Sub

sub này bị lỗi khi dữ liệu chưa có dòng nào hoặc 1 dòng??
Thanks

Bạn nên thay cái đó bằng cái này:

Sub TaoSTT()
    Dim LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        Select Case LastRow
        Case Is < 13
            Exit Sub
        Case 13
            .Range("A13") = 1
        Case 14
            .Range("A13") = 1
            .Range("A14") = 2
        Case Else
            .Range("A13") = 1
            .Range("A14") = 2
            .Range("A13:A14").AutoFill Destination:=.Range("A13:A" & LastRow)
        End Select
    End With
End Sub

Nhưng tốt nhất bạn gửi lên đây cho tôi cái file có cấu trúc thật đi để tôi tiện giúp bạn.

 

[vanhesing]

Nếu cột lên đến bao nhiêu thì thay ":N" là tên của cột đó, ví dụ tới cột AD thì thay thành: ":AD"


Vấn đề nhảy lên hơn 10 dòng là ở chỗ này:

    For r = 1 To u
        sArray(r, 14) = r   [B][COLOR=#ff0000]13[/COLOR][/B]
        Dict(sArray(r, 3)) = sArray(r, 3)
    Next

Từ hàng 1 đến hàng có chứa tiêu đề (có 2 dòng) có bao nhiêu hàng thì tổng số hàng đó bạn cộng thêm 1 nữa là OK. Và như thế, nó phải thay thế nhiều thứ khác như tôi lấy mốc ở ô A13 giả sử số thứ tự đầu tiên ở ô đó, nhưng với dữ liệu của bạn ở ô A3 thì bạn phải sửa tất cả các Range có chứa A13 thành A3. Và như vậy:

sArray(r, 14) = r 13 thành sArray(r, 14) = r 3




Bạn nên thay cái đó bằng cái này:

Sub TaoSTT()
    Dim LastRow As Long
    With Sheet1
        LastRow = .Range("B65536").End(xlUp).Row
        Select Case LastRow
        Case Is < 13
            Exit Sub
        Case 13
            .Range("A13") = 1
        Case 14
            .Range("A13") = 1
            .Range("A14") = 2
        Case Else
            .Range("A13") = 1
            .Range("A14") = 2
            .Range("A13:A14").AutoFill Destination:=.Range("A13:A"

 

[Hoàng Trọng Nghĩa]

-Vấn đề chổ này
sArray(r, 14) = r + 13 Do tôi mơ hồ copy đoạn r +13 này từ đầu và để số cột rồi sau đó cứ ngẫm cái đoạn nên không biết. Đọc giải thích rồi nhìn lại đọan copy tôi mới thấy sai chổ đó.
-code nap STT thì đã test ok

-Cảm ơn Anh Nghĩa, không phải dữ liệu quan trọng gì đâu mà không post file gốc chỉ là cuốn theo code của Anh nên tôi học hỏi thêm với lại tôi muốn tự mình chỉnh code theo file gốc cho nhớ. tất cả vấn đề đều đã được nhờ Anh giải thích tôi đã xử lý được rồi. Dựa vào code của Anh tôi bổ sung thêm 2 command nữa đó là sữa dữ liệu và xóa dữ liệu .Cũng chỉ là copy paste nhưng rất vui vì đã hiểu cũng kha khá .

Private Sub Cmdsua_Click()
Dim c As Byte,[COLOR=#ff0000][B] i As Range[/B][/COLOR]
    Dim RowIndex As Long
    RowIndex = ListBox1.List(, 13) - 1
       For c = 1 To 12
        Sheet1.Range("A" & RowIndex).Offset(, c) = Controls("combobox" & c)
    Next
    Call TaoSTT
    Call Nap
     ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Private Sub Cmdxoa_Click()
 [COLOR=#ff0000][B]Dim c As Byte, i As Range[/B][/COLOR]
    Dim RowIndex As Long
    RowIndex = ListBox1.List(, 13) - 1
    Sheet1.Range("A" & RowIndex & ":n" & RowIndex).Delete Shift:=xlUp
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Chúc Anh vui vẻ và nhiều sức khỏe

Sao trong code của bạn lại có những Biến không được dùng nhỉ? Nếu không sử dụng thì xóa đi, để chi cho thừa thải vậy bạn?

 

[vanhesing]

Sao trong code của bạn lại có những Biến không được dùng nhỉ? Nếu không sử dụng thì xóa đi, để chi cho thừa thải vậy bạn?

À, do lúc nghiên cứu biến tấu code của Anh nên chưa xóa .Cảm ơn nhắc nhở của Anh

 

[Hoàng Trọng Nghĩa]

À, do lúc nghiên cứu biến tấu code của Anh nên chưa xóa .Cảm ơn nhắc nhở của Anh

Vả lại, bạn "biến tấu" đôi khi không đúng và còn vụng về các trường hợp (xóa, sửa). Bây giờ, để tiện cho bạn không phải sửa code khi thay đổi qua file chính, khi mà hàng đầu tiên của số thứ tự đầu tiên không như file test thì tôi làm luôn cho bạn, bạn chỉ cần thay thế số dòng trong câu lệnh này, còn lại nó tự hiểu phải làm gì:

Private Const StandardRow As Long = 6

Và đây là toàn bộ code tôi viết lại cho bạn:

Option Explicit
Private sArray
Private RowIndex As Long
[COLOR=#0000ff][B]Private Const StandardRow As Long = [/B][/COLOR][SIZE=5][COLOR=#ff0000][B]6[/B][/COLOR][/SIZE]


Private Sub UserForm_Initialize()
    Call Nap
End Sub


Sub TaoSTT()
    Dim LastRow As Long
    With Sheet1
        LastRow = .Range("E65536").End(xlUp).Row
        Select Case LastRow
        Case Is < StandardRow
            Exit Sub
        Case StandardRow
            .Range("A" & StandardRow) = 1
        Case StandardRow + 1
            .Range("A" & StandardRow) = 1
            .Range("A" & StandardRow + 1) = 2
        Case Else
            .Range("A" & StandardRow) = 1
            .Range("A" & StandardRow + 1) = 2
            .Range("A" & StandardRow).Resize(2, 1).AutoFill _
             Destination:=.Range("A" & StandardRow & ":A" & LastRow)
        End Select
    End With
End Sub


Sub Nap()
    Dim Dict As Object
    Dim LastRow As Long, r As Long, u As Long
    LastRow = Sheet1.Range("E65536").End(xlUp).Row
    sArray = Sheet1.Range("A" & StandardRow & ":N" & LastRow).Value
    u = UBound(sArray)
    ''Dung de loc duy nhat so nha, gan cho Combobox:
    Set Dict = CreateObject("Scripting.Dictionary")
    For r = 1 To u
        sArray(r, 14) = r + StandardRow
        Dict(sArray(r, 3)) = sArray(r, 3)
    Next
    ListBox1.List() = sArray
    LOC.List = Dict.Keys
End Sub


Private Sub ListBox1_Click()
    Dim c As Byte
    For c = 1 To 12
        Controls("Combobox" & c) = ListBox1.List(, c)
    Next
    RowIndex = ListBox1.List(, 13)
    cmdInsert.Enabled = True
    Cmdxoa.Enabled = True
    Cmdsua.Enabled = True
End Sub


Private Sub LOC_Change()
    ListBox1.List() = Filter2DArray(sArray, 3, LOC.Text & "*", False)
End Sub


Private Sub cmdInsert_Click()
    Dim c As Byte
    Sheet1.Range("A" & RowIndex & ":P" & RowIndex).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For c = 1 To 12
        Sheet1.Range("A" & RowIndex).Offset(, c) = Controls("Combobox" & c)
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - StandardRow
End Sub


Private Sub NUTNL_Click()
    Dim c As Long, LastRow As Long
    With Sheet1
        LastRow = .Range("E65536").End(xlUp).Row + 1
        For c = 1 To 12
            Sheet1.Range("A" & LastRow).Offset(, c) = Controls("Combobox" & c)
        Next
    End With
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub


Private Sub Cmdxoa_Click()
    Sheet1.Range("A" & RowIndex - 1 & ":n" & RowIndex).Delete Shift:=xlUp
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - 1 - StandardRow
End Sub


Private Sub Cmdsua_Click()
    Dim c As Byte
    For c = 1 To 12
        Sheet1.Range("A" & RowIndex - 1).Offset(, c) = Controls("Combobox" & c)
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - 1 - StandardRow
End Sub

 

[vanhesing]

Private Sub Cmdxoa_Click()
    Sheet1.Range("A"

 

[vanhesing]

Anh Nghĩa vui lòng giúp nốt tôi phần này với,tôi đã mò đủ kiểu nhưng vẫn lỗi.cơ bản mặc định code Anh xóa 1 lần 2 dòng nếu chọn random.còn chọn dòng cuối thì báo lỗi . - - -

 

[doveandrose]

Anh Nghĩa vui lòng giúp nốt tôi phần này với,tôi đã mò đủ kiểu nhưng vẫn lỗi.cơ bản mặc định code Anh xóa 1 lần 2 dòng nếu chọn random.còn chọn dòng cuối thì báo lỗi .

tôi không tham gia từ đầu nên không biết tại sao lại phải xóa 1 lần 2 dòng ? tôi đâu thấy 2 dòng liên tiếp có liên quan gì ?
đây là code xóa 1 lần 1 dòng . xóa dòng nào tùy

Private Sub Cmdxoa_Click()
    Sheet1.Range("A" & RowIndex - 1 & ":n" & RowIndex - 1).Delete Shift:=xlUp
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = WorksheetFunction.Min(RowIndex - 1 - StandardRow, ListBox1.ListCount - 1)
End Sub

 

[vanhesing]

tôi không tham gia từ đầu nên không biết tại sao lại phải xóa 1 lần 2 dòng ? tôi đâu thấy 2 dòng liên tiếp có liên quan gì ?
đây là code xóa 1 lần 1 dòng . xóa dòng nào tùy

Private Sub Cmdxoa_Click()
    Sheet1.Range("A"

 

[Hoàng Trọng Nghĩa]

Chào bạn !
Quả thật 2 dòng liên tiếp không có liên quan và mình cũng không uốn xóa như vậy.mình chỉ muốn xóa 1 dòng và code của bạn đã đúng ý mình.hóa ra vấn đề đơn giản vậy.
Cảm ơn bạn đã khai sáng , chúc sức khỏe bạn

Cuối tuần với gia đình nên không lên mạng. Nếu không muốn đụng chạm gì đến WorksheetFunction thì dùng code sau:

Private Sub Cmdxoa_Click()
    Dim ListIndex As Long
    Sheet1.Range("A" & RowIndex - 1 & ":n" & RowIndex).Delete Shift:=xlUp
    Call TaoSTT
    Call Nap
    ListIndex = RowIndex - 1 - StandardRow
    With ListBox1
        .ListIndex = IIf(ListIndex < .ListCount - 1, ListIndex, .ListCount - 1)
    End With
End Sub

 

[vanhesing]

Cuối tuần với gia đình nên không lên mạng. Nếu không muốn đụng chạm gì đến WorksheetFunction thì dùng code sau:

Private Sub Cmdxoa_Click()
    Dim ListIndex As Long
    Sheet1.Range("A"

 

[Hoàng Trọng Nghĩa]

ok rồi Anh
Anh vui lòng cho tôi hỏi thêm 1 cái nữa .
Sau khi nạp và lọc trên listbox tôi tạo một label đếm lấy tổng các số nhà có ký tự là "A".Đếm cột số nhà trong trong listbox sau khi lọc chứ không phải đếm trên range.
Thanks Anh

Tôi thêm cho bạn:

1) TextBox: Bạn gõ ký tự cần tìm

2) Label: Đếm số lượng ký tự đó xuất hiện trên tổng số mục đã lọc (x/X)

3) Ở CoboBox tìm kiếm, tôi thêm một dấu sao (*) để lọc ký tự bất kỳ chứa trong dãy số nhà, thay vì gõ 137 thì chỉ cần gõ 37 nó cũng sẽ lọc toàn bộ những địa chỉ có số *37*.

4) Code cho các sự kiện:

Private Sub LOC_Change()
    On Error Resume Next
[B]    arrFilter = Filter2DArray(sArray, 3,[COLOR=#ff0000] "*" &[/COLOR] LOC.Text & "*", False)[/B]
    ListBox1.List() = arrFilter
    txtKey = ""
    lblCount = ""
End Sub


Private Sub txtKey_Change()
    If IsArray(arrFilter) Then
        Dim r As Long, u As Long, i As Long
        u = UBound(arrFilter)
        For r = 1 To u
            If InStr(UCase(arrFilter(r, 3)), UCase(txtKey)) Then
                i = i + 1
            End If
        Next
        lblCount = i & " / " & u
    End If
End Sub

 

[vanhesing]

Rất đúng ý tôi .Chân thành cảm ơn Anh .
Tôi đã có làm như Anh cũng dùng hàm Filter2Darray để lọc rồi dù code viết không pro bằng Anh .thêm 1 ví dụ , nếu tôi có thêm nhiều cái label nữa , lần này , điều kiện đếm là "A1", "A2", "A3","B1","B2","B3","C1","C2","C3" và không cần textbox để tìm kí tự gần giống (Anh sữa cột số nhà theo dk giùm ).vậy ta sẽ dùng bao nhiu vòng lặp lồng vào nhau ?cho các label mặc định theo số thứ tự, cho dễ dàng khi dùng vòng lặp. Anh có thể hướng dẫn tôi bằng code vòng lặp thích hợp được không?
Thú thật tôi đang cố gắng học và hiểu về các vòng lặp.
Thanks Anh

 

[Hoàng Trọng Nghĩa]

Rất đúng ý tôi .Chân thành cảm ơn Anh .
Tôi đã có làm như Anh cũng dùng hàm Filter2Darray để lọc rồi dù code viết không pro bằng Anh .thêm 1 ví dụ , nếu tôi có thêm nhiều cái label nữa , lần này , điều kiện đếm là "A1", "A2", "A3","B1","B2","B3","C1","C2","C3" và không cần textbox để tìm kí tự gần giống (Anh sữa cột số nhà theo dk giùm ).vậy ta sẽ dùng bao nhiu vòng lặp lồng vào nhau ?cho các label mặc định theo số thứ tự, cho dễ dàng khi dùng vòng lặp. Anh có thể hướng dẫn tôi bằng code vòng lặp thích hợp được không?
Thú thật tôi đang cố gắng học và hiểu về các vòng lặp.
Thanks Anh

Đúng là ĐƯỢC VOI ĐÒI 2 BÀ TƯNG mà!

Lỡ cưỡi bà Tưng rồi, ủa quên, lỡ cưỡi voi rồi phải đi luôn chớ biết làm sao!

Private Sub LOC_Change()
    On Error Resume Next
    Dim arrFilter, arrKey
    Dim arrCount(0 To 11) As Long
    Dim c As Long, uc As Long, r As Long, ur As Long
    
    arrKey = Array("A", "B", "C", "A1", "A2", "A3", "B1", "B2", "B3", "C1", "C2", "C3")
    
    arrFilter = Filter2DArray(sArray, 3, "*" & LOC.Text & "*", False)
    ListBox1.List() = arrFilter
    
    ur = UBound(arrFilter): uc = UBound(arrKey)
    
    For r = 1 To ur
        For c = 0 To uc
            If InStr(UCase(arrFilter(r, 3)), arrKey(c)) Then
                arrCount(c) = arrCount(c) + 1
            End If
        Next
    Next
    
    For c = 0 To uc
        Select Case c
        Case 0 To 2
            Controls("lbl" & arrKey(c)) = "Nhóm " & arrKey(c) & ": " & arrCount(c)
        Case Else
            Controls("lbl" & arrKey(c)) = arrKey(c) & ": " & arrCount(c)
        End Select
    Next
End Sub

Code cho 12 Label đó.

 

[vanhesing]

Đúng là ĐƯỢC VOI ĐÒI 2 BÀ TƯNG mà!

Lỡ cưỡi bà Tưng rồi, ủa quên, lỡ cưỡi voi rồi phải đi luôn chớ biết làm sao!

Bể học mênh mông mà Anh.Không biết phải hỏi, càng hỏi càng mù.
Cưỡi bà Tưng thì tôi không ngại đâu .
Tôi không đòi voi nữa đâu chỉ muốn hỏi thêm 1 câu :
Các số từ các control trên form đưa xuống cells đều bị lỗi và mất số "0" đầu .thật đau đầu khi phải convert to number từng cột.
Thanks và chúc sức khỏe

 

[Hoàng Trọng Nghĩa]

Bể học mênh mông mà Anh.Không biết phải hỏi, càng hỏi càng mù.
Cưỡi bà Tưng thì tôi không ngại đâu .
Tôi không đòi voi nữa đâu chỉ muốn hỏi thêm 1 câu :
Các số từ các control trên form đưa xuống cells đều bị lỗi và mất số "0" đầu .thật đau đầu khi phải convert to number từng cột.
Thanks và chúc sức khỏe

Muốn giữ là số thì dùng hàm Val. Ví dụ:

Range("A1").Value = Val(TextBox1)

 

[vanhesing]

Muốn giữ là số thì dùng hàm Val. Ví dụ:

Range("A1").Value = Val(TextBox1)

Nhưng trong file ta dùng vòng lặp

 

[Hoàng Trọng Nghĩa]

Nhưng trong file ta dùng vòng lặp

Bạn nên định dạng ở các cột 1, 7, 9 (B, H, J) với cột 1 là General, 7 là dd/mm/yyyy, 9 là 000000000. Các số liệu đã lưu trước nên sửa về đúng định dạng chuẩn của nó thì mới dễ dàng thao tác được (tôi đánh giá cao sự "gan dạ" của bạn vì chương trình chưa hoàn thành đã dám nhập vào CSDL).

Việc code có dòng lặp ta làm như sau:

Private Sub Cmdsua_Click()
    Dim c As Byte
    For c = 1 To 12
        Select Case c
        Case 1, 9
            Sheet1.Range("A" & RowIndex - 1).Offset(, c) = Val(Controls("Combobox" & c))
        Case 7
            Sheet1.Range("A" & RowIndex - 1).Offset(, c) = DateValue(Controls("Combobox" & c))
        Case Else
            Sheet1.Range("A" & RowIndex - 1).Offset(, c) = Controls("Combobox" & c)
        End Select
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - 1 - StandardRow
End Sub

Private Sub cmdInsert_Click()
    Dim c As Byte
    Sheet1.Range("A" & RowIndex & ":P" & RowIndex).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For c = 1 To 12
        Select Case c
        Case 1, 9
            Sheet1.Range("A" & RowIndex).Offset(, c) = Val(Controls("Combobox" & c))
        Case 7
            Sheet1.Range("A" & RowIndex).Offset(, c) = (Controls("Combobox" & c))
        Case Else
            Sheet1.Range("A" & RowIndex).Offset(, c) = Controls("Combobox" & c)
        End Select
    Next
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = RowIndex - StandardRow
End Sub


Private Sub NUTNL_Click()
    Dim c As Long, LastRow As Long
    With Sheet1
        LastRow = .Range("E65536").End(xlUp).Row + 1
        For c = 1 To 12
            Select Case c
            Case 1, 9
                .Range("A" & LastRow).Offset(, c) = Val(Controls("Combobox" & c))
            Case 7
                .Range("A" & LastRow).Offset(, c) = DateValue(Controls("Combobox" & c))
            Case Else
                .Range("A" & LastRow).Offset(, c) = Controls("Combobox" & c)
            End Select
        Next
    End With
    Call TaoSTT
    Call Nap
    ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

 

[Hoàng Trọng Nghĩa]

Các số từ các control trên form đưa xuống cells đều bị lỗi và mất số "0" đầu .thật đau đầu khi phải convert to number từng cột.
Thanks và chúc sức khỏe

Để chữa cháy cho trường hợp này ta làm như sau:

Chọn khối ô cần Convert thành Number (đừng chọn cả cột nha, chọn khối có giá trị thôi, chọn cả cột có khi hút xong điếu thuốc nó chưa chạy xong đấy) rồi chạy code sau:

Sub NumberConvert()
    On Error Resume Next
    Dim cell As Range
    For Each cell In Selection
        If cell.Value > "" Then
            cell.Value = Val(cell)
        End If
    Next
End Sub

Tương tự với cột ngày tháng:

Sub DateConvert()
    On Error Resume Next
    Dim cell As Range
    For Each cell In Selection
        If cell.Value > "" Then
            cell.Value = DateValue(cell)
        End If
    Next
End Sub

Trời ơi, gõ thủ công từng ngày một chắc giập mật quá!

 

[vanhesing]

Bạn nên định dạng ở các cột 1, 7, 9 (B, H, J) với cột 1 là General, 7 là dd/mm/yyyy, 9 là 000000000. Các số liệu đã lưu trước nên sửa về đúng định dạng chuẩn của nó thì mới dễ dàng thao tác được (tôi đánh giá cao sự "gan dạ" của bạn vì chương trình chưa hoàn thành đã dám nhập vào CSDL).

Việc code có dòng lặp ta làm như sau:

Private Sub Cmdsua_Click()
    Dim c As Byte
    For c = 1 To 12
        Select Case c
        Case 1, 9
            Sheet1.Range("A"

 

[Hoàng Trọng Nghĩa]

Anh đừng đề cao sự gan dạ tôi thế, CSDL của tôi không có dòng nào bị vậy cả(chỉ bị mỗi ô số dt) .Trước kia tôi nhập không dùng vòng lặp mà .còn file mẫu tôi gửi lên diễn đàn chỉ là file test copy dữ liệu nên chưa convert nên tôi không gan dạ như Anh nghỉ đâu

Bạn biết cách phân biệt đâu là chuỗi, đâu là số chưa? Khi không định dạng canh trái, canh phải hay canh giữa, mặc nhiên Text thì nằm bên trái ô, Number thì lại nằm bên phải. Cả 3 cột mà tôi nói đều là như thế, bạn xem file test tôi tải từ bài đầu tiên của bạn để xem nhé.