Nhờ các bác sửa hoặc tối ưu code tìm kiếm ạ (1 người xem)

  • Thread starter Thread starter duhero
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

duhero

Thành viên chính thức
Tham gia
8/10/10
Bài viết
69
Được thích
1
Chào các Anh/Chị
em là dân ngoại đạo mò mẫm ghép nối lại được code phù hợp cho nhu cầu công việc của mình, nhưng mới chỉ mò được tìm kiếm ở 1 sheet cụ thể thôi, e ko biết làm sao để sửa tìm kiếm trong tất cả các sheet, nên mong được giúp đỡ ạ. PS: Em ko biết có phải up file lên ko ạ?
Mã:
Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    Dim FistAddress As String
    Dim LastAddress As String
    Dim Result As Range
    Dim ws As Worksheet
    Dim firstAdd As String
   
    ' Xóa dong trong trong sheet NET
    Sheets("NET").Select
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete

   
   
    'Tim gia tri dau tien
       
    FindString = InputBox("May Can Tim Kiem Cai Gi:", "Tra Cuu So Do Mang Luoi")
        If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("C:D")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            firstAdd = Rng.Address
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Cells(Rng.Row, 13).Value = 1
                FistAddress = Rng.Row
            Else
                MsgBox "Nothing found"
            End If
        End With
       
        'Tim gia tri cuoi cung
                With Sheets("Sheet1").Range("C:D")
            Do
           
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
               
                    'Rng = Cells(LastAddress, 3)
                    'Set Rng = .FindNext(Rng)
           
                Application.Goto Rng, True
                    Cells(Rng.Row, 13).Value = 2
                    LastAddress = Rng.Row
                    'MsgBox Cells(Rng.Row, 11)
                    'MsgBox Cells(Rng.Row, 3)
                    Set Rng = Cells(LastAddress, 3)
                    Set Rng = .FindNext(Rng)
                    FindString = Cells(LastAddress, 3)
            Else
                MsgBox "Nothing found"
            End If
            Loop While firstAdd <> Rng.Address And Cells(Rng.Row, 11) > 600
    'Copy sang Sheet NET
    Set Result = Range(Cells(FistAddress, 1), Cells(LastAddress, 12))
    Result.Select
    Selection.Copy Destination:=Sheets("NET").Range("A4")
    Sheet23.Activate
           
        End With
       
    End If

End Sub
 
Lần chỉnh sửa cuối:
1. Nên thay
Dim FindString As String
Dim Rng As Range
Dim FistAddress As String
Dim LastAddress As String
Dim Result As Range
Dim ws As Worksheet
Dim firstAdd As String
bằng
Dim FindString$, Rng As Range, FistAddress$, LastAddress$, Result As Range, ws As Worksheet, firstAdd$
cho nó gọn. Nếu xx là biến số kiểu byte hay integer hay long thì viết xx& (kiểu long).

2. Nên gửi file. Để tiện chạy thử chương trình
 
Upvote 0
1. Nên thay
Dim FindString As String
Dim Rng As Range
Dim FistAddress As String
Dim LastAddress As String
Dim Result As Range
Dim ws As Worksheet
Dim firstAdd As String
bằng
Dim FindString$, Rng As Range, FistAddress$, LastAddress$, Result As Range, ws As Worksheet, firstAdd$
cho nó gọn. Nếu xx là biến số kiểu byte hay integer hay long thì viết xx& (kiểu long).

Nếu cần giảm số dòng, và giảm ký tự thì cứ việc làm theo. Về cái chuyện "nên" thì chưa chắc đã đúng.

Các cách khai báo kiểu $, &, ... là cách mà VBA giữ lại để đồng bộ với các code thời thượng cổ. Khi loại lập trình hướng đối tượng thịnh hành thì cách khai chết kiểu trong tên đã trở nên lỗi thời. Chỉ có VBA vì chưa thể hướng đối tượng nên mới còn xài.
 
Upvote 0
Nếu cần giảm số dòng, và giảm ký tự thì cứ việc làm theo. Về cái chuyện "nên" thì chưa chắc đã đúng.

Các cách khai báo kiểu $, &, ... là cách mà VBA giữ lại để đồng bộ với các code thời thượng cổ. Khi loại lập trình hướng đối tượng thịnh hành thì cách khai chết kiểu trong tên đã trở nên lỗi thời. Chỉ có VBA vì chưa thể hướng đối tượng nên mới còn xài.
Cảm ơn 2 bác e vẫn chưa biết cách tối ưu code vì ko biết gì về VBA
 
Upvote 0
Chưa nói đến nội dung; Về hình thức thì nên là vầy:
PHP:
Sub Find_First()
 Dim FindString As String, FistAddress As String, LastAddress As String, firstAdd As String
 Dim Result As Range, ws As Worksheet, Rng As Range
    ' Xóa dòng tróng trong sheet NET    '
 Sheets("NET").Select:                              Range("A4").Select
 Range(Selection, Selection.End(xlDown)).Select
 Application.CutCopyMode = False
 Selection.EntireRow.Delete
    'Tim gia tri dau tien   '
 FindString = InputBox("May Can Tim Kiem Cai Gi:", "Tra Cuu So Do Mang Luoi")
 If Trim(FindString) <> "" Then
    With Sheets("Sheet1").Range("C:D")
        Set Rng = .Find(What:=FindString, After:=.Cells(.Cells.Count), LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        firstAdd = Rng.Address
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
            Cells(Rng.Row, 13).Value = 1
            FistAddress = Rng.Row
        Else
            MsgBox "Nothing found"
        End If
    End With
    'Tim gia tri cuoi cung          '
    With Sheets("Sheet1").Range("C:D")
        Do
            Set Rng = .Find(What:=FindString, After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
            If Not Rng Is Nothing Then
                'Rng = Cells(LastAddress, 3)    '
                'Set Rng = .FindNext(Rng)       '
                Application.Goto Rng, True
                Cells(Rng.Row, 13).Value = 2
                LastAddress = Rng.Row
                'MsgBox Cells(Rng.Row, 11)  ':                'MsgBox Cells(Rng.Row, 3)   '
                Set Rng = Cells(LastAddress, 3)
                Set Rng = .FindNext(Rng)
                FindString = Cells(LastAddress, 3)
            Else
                MsgBox "Nothing found"
            End If
        Loop While firstAdd <> Rng.Address And Cells(Rng.Row, 11) > 600
    'Copy sang Sheet NET    '
        Set Result = Range(Cells(FistAddress, 1), Cells(LastAddress, 12))
        Result.Select
        Selection.Copy Destination:=Sheets("NET").Range("A4")
        Sheet23.Activate
    End With
 End If
End Sub

Thứ nhất, nếu toàn bộ các dòng lệnh không nằm trọn màn hình vi tính, thì chí ít cũng kéo chuột tối thiểu để xem & kiểm toàn bộ các dòng lệnh; Từ đó ta dễ dàng quán xuyến nội dung của các dòng lệnh & liên quan của chúng.

Thứ đến: Mình thì thường các biến cùng kiểu loại ta nên để trên cùng 1 dòng; & cũng nhằm quán xuyến các biến đã khai báo;
Khai báo biến nên có độ dài vừa phải; Như fAddrr thay cho FistAddress , lAddr thay cho LastAddress ; Chuyện này để tiết kiệm công sức khi phải gõ tên biến.

Ngoài ra: Hạn chế tối thiểu việc để các dòng trống hay quá ít từ hay mệnh đề trong dòng của câu lệnh.
1 câu lệnh ta có thể phải ngắt thành 2 hay 3 dòng, chứ không nên nhiều hơn khi cho phép;
Ngắt dòng như trong macro của bạn chỉ dành cho những người viết Code đã bài bản & 'hàn lâm' mà thôi.

Với hình thức như vậy chỉ tăng thêm thiện cảm với những người có nhã í giúp bạn!

Thân chào & chúc vui khỏe!
 
Upvote 0
Cảm ơn anh, thú thực là em ko biết VBA chỉ là cóp nhặt và tùy biến lại cho nhu cầu của mình ạ, hii
 
Upvote 0
Web KT

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

Back
Top Bottom