Lấy dữ liệu theo vòng tròn.

[TrungChinhs]

Nhiều khi trong một chương trình ta phải tạo nhiều nút lệnh để chạy các Sub khác nhau. Để khỏi vẽ nhiều nút, tôi cho các lệnh đó chạy theo điều kiện xuất hiện trong một ô nhất định. Với mỗi một lần dữ liệu trong ô thay đổi thì ta lại cho máy tự động chạy một code để làm gì đó ứng với dữ liệu điều kiện vừa xuất hiện trong ô (giống như ta đạp số xe máy từ số 0 ta đạp tiếp vào số 1, rôi đạp tiếp vào số 2... rồi đạp tiếp lại về số 0).

Ví dụ tại Sheets("TongHop") tôi chọn ô C7 để hiện dữ liệu điều kiện, khi muốn lấy dữ liệu từ một Sheets nào đó về Sheets("TongHop") thì tôi đúp chuột vào ô C7 cho đến khi xuất hiện điều kiện tôi cần vậy là tôi có được kết quả mong muốn - Khi ta đúp chuột máy sẽ lần lượt chạy 2 code: đầu tiên là code để xuất hiện điều kiện, tiếp đó là code cho kết quả theo điều kiện vừa xuất hiện.

Ứng dụng của cách làm này đối với những công việc có tính quy luật lặp lại thì viết code đơn giản, ngắn gọn nhưng khả năng tùy biến cao.

Tôi đã dùng thành công trong một số công việc nên hôm nay tạo 1 file demo Port lên đây để các bạn tham khảo đồng thời muốn nghe ý kiến thảo luận của các bạn các bạn để tôi học hỏi thêm.

 

[ptm0412]

Anh ơi, sao trong sheet DM anh không thêm 1 cột "tên biểu" để gán cho ô C12, khỏi thêm 1 sub Find_copy, khỏi lặp 1 vòng qua các sheet?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = 0
Cancel = 1
On Error Resume Next
    If Not Intersect(Target, [c7]) Is Nothing Then
        With Sheets("TongHop")
            For Each cls In Sheets("Dm").[b3:b50].SpecialCells(2)
                If .[c7] = cls Then cls(2).Copy .[c7]: .[c12] = cls.Offset(1, 2): Exit Sub
                If cls(3) = 0 Then Sheets("Dm").[b3].Copy .[c7]: .[c12] = "": Exit Sub
            Next
        End With
    End If
'Tiep:
'    Call Find_Copy: Exit Sub
End Sub

 

[TrungChinhs]

Anh ơi, sao trong sheet DM anh không thêm 1 cột "tên biểu" để gán cho ô C12, khỏi thêm 1 sub Find_copy, khỏi lặp 1 vòng qua các sheet?
[/php]

à... như tôi đã nói ở trên cái sub Fild_copy đó chỉ là ví dụ ta làm cái gì gì ... đó ứng với điều kiện mới xuất hiện. Thực tế có thể là một công việc phức tạp hơn nhiều như truy xuất một biểu hoặc thực hiện một sub tổng hợp số liệu hoặc nếu điều kiện là Delete thì thực hiện câu lệnh xóa, Rename thì thực hiện câu lệnh sửa và Add thì thực hiện câu lệnh thêm một recode của Data...

 

[ndu96081631]

Nhiều khi trong một chương trình ta phải tạo nhiều nút lệnh để chạy các Sub khác nhau. Để khỏi vẽ nhiều nút, tôi cho các lệnh đó chạy theo điều kiện xuất hiện trong một ô nhất định. Với mỗi một lần dữ liệu trong ô thay đổi thì ta lại cho máy tự động chạy một code để làm gì đó ứng với dữ liệu điều kiện vừa xuất hiện trong ô (giống như ta đạp số xe máy từ số 0 ta đạp tiếp vào số 1, rôi đạp tiếp vào số 2... rồi đạp tiếp lại về số 0).

Ví dụ tại Sheets("TongHop") tôi chọn ô C7 để hiện dữ liệu điều kiện, khi muốn lấy dữ liệu từ một Sheets nào đó về Sheets("TongHop") thì tôi đúp chuột vào ô C7 cho đến khi xuất hiện điều kiện tôi cần vậy là tôi có được kết quả mong muốn - Khi ta đúp chuột máy sẽ lần lượt chạy 2 code: đầu tiên là code để xuất hiện điều kiện, tiếp đó là code cho kết quả theo điều kiện vừa xuất hiện.

Ứng dụng của cách làm này đối với những công việc có tính quy luật lặp lại thì viết code đơn giản, ngắn gọn nhưng khả năng tùy biến cao.

Tôi đã dùng thành công trong một số công việc nên hôm nay tạo 1 file demo Port lên đây để các bạn tham khảo đồng thời muốn nghe ý kiến thảo luận của các bạn các bạn để tôi học hỏi thêm.

Bài này nếu là em thì em làm khác: Tạo 1 sub có tham số truyền vào chứ không dùng vòng lập!
1> Code trong Module

Sub Find_Copy(sRange As Range)
  On Error Resume Next
  sRange.Copy Sheets("TongHop").Range("C12")
End Sub

1> Code trong sheet TongHop

Private fRng As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
  If Target.Address = "$C$7" Then
    If fRng Is Nothing Then
      Set fRng = Sheet10.Range("B1:B100").Find("*")
    Else
      Set fRng = Sheet10.Range("B1:B100").FindNext(fRng)
    End If
    Find_Copy Sheets(fRng.Offset(, 1).Value).Range("B2")
    Target = fRng: Cancel = True
  End If
End Sub

 

[TrungChinhs]

Bài này nếu là em thì em làm khác: Tạo 1 sub có tham số truyền vào chứ không dùng vòng lập!
1> Code trong Module

Sub Find_Copy(sRange As Range)
  On Error Resume Next
  sRange.Copy Sheets("TongHop").Range("C12")
End Sub

1> Code trong sheet TongHop

Private fRng As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
  If Target.Address = "$C$7" Then
    If fRng Is Nothing Then
      Set fRng = Sheet10.Range("B1:B100").Find("*")
    Else
      Set fRng = Sheet10.Range("B1:B100").FindNext(fRng)
    End If
    Find_Copy Sheets(fRng.Offset(, 1).Value).Range("B2")
    Target = fRng: Cancel = True
  End If
End Sub

Cảm ơn Ndu !. Mình đã chạy thử code của bạn nhưng... Rất tuyệt ... khà...khà...!!!. Cái món tham số truyền này mình chưa biết viết (trên diễn đàn này có nói nhiều nhưng vì mình chưa hiểu gì về nó nên không để ý nghiên cứu - Chưa đau nên chưa cần thuốc chữa). Bạn có thể hướng dẫn (diễn nôm) cách viết loại sub này cho mình được không ? Nếu được thì... mới cảm ơn sau nha !

 

[ndu96081631]

Cảm ơn Ndu !. Mình đã chạy thử code của bạn nhưng... Rất tuyệt ... khà...khà...!!!. Cái món tham số truyền này mình chưa biết viết (trên diễn đàn này có nói nhiều nhưng vì mình chưa hiểu gì về nó nên không để ý nghiên cứu - Chưa đau nên chưa cần thuốc chữa). Bạn có thể hướng dẫn (diễn nôm) cách viết loại sub này cho mình được không ? Nếu được thì... mới cảm ơn sau nha !

Sub có tham số truyền vẫn bình thường như bao code bình thường khác thôi anh à!... Chẳng qua là ta viết sẳn để đó, khi nào cho tham số vào thì.. chạy! Vậy thôi
Ví dụ anh có code thế này

Sub STT()
  With Range("A1:A10")
    .Value = Evaluate("ROW(R:R)")
    .Font.Bold = True
    .Font.Italic = True
    .Font.Size = 12
  End With
End Sub

Mai này khi anh muốn code tác động ở vùng khác, anh lại phải vào sửa lại vùng A1:A10 thành 1 vùng nào đó, đúng không? Vậy anh có thể viết theo cách sau:

Sub STT(sRange As Range)
  With sRange
    .Value = Evaluate("ROW(R:R)")
    .Font.Bold = True
    .Font.Italic = True
    .Font.Size = 12
  End With
End Sub

Code này chưa biết vùng sRange là vùng nào, xem như để chờ đó, khi nào cần thì chạy bằng 1 sub khác và truyền tham số sRange cụ thể vào! Ví dụ:

Sub Main()
  STT [B5:B10]
End Sub

Sub Main này sẽ gọi Sub STT với vùng cụ thể chính là B5:B10 ---> Cách viết gần giống như 1 Function ---> Rất đơn giản phải không?
Ẹc... Ẹc...
--------------------------
Chắc anh còn nhớ topic của anh:
http://www.giaiphapexcel.com/forum/showthread.php?42952-L%E1%BA%A5y-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-file-kh%C3%B4ng-m%E1%BB%9F
Em đã sửa code của anh thành sub có tham số truyền

Private Sub ImPortDaTa_FileClose(FileName As String, ShName As String)
  On Error Resume Next
  With ActiveSheet
    .Cells.Clear
    With .QueryTables.Add(Connection:=Array("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";Jet OLEDB:Engine Type=35"), Destination:=Selection)
      .CommandType = xlCmdTable
      .CommandText = Array(ShName & "$")
      .Refresh BackgroundQuery:=False
    End With
    Selection.EntireRow.Delete
    .UsedRange.Columns.AutoFit
  End With
End Sub

Khi anh đã có trong tay Tên File + Tên Sheet thì cứ thế vào code và chạy sẽ ra kết quả (thay vì mổi lần thay đổi phải vào code sửa lại)
-------------------------
Code kiểu này thường áp dụng cho trường hợp 1 code nào đó mà ta hay dùng đi dùng lại nhiều lần nhưng mổi lần lại phải thay đổi 1 vài đối số nào đó ---> Vậy ta sẽ viết thành 1 sub TỔNG QUÁT, với đối số "chờ sẳn"... cần thì truyền vào

 

[TrungChinhs]

Cảm ơn Ndu ! đã hướng dẫn, đọc bài của bạn thì tôi đã hiểu sơ sơ và thấy cũng không quá khó nhưng để tự làm được chắc còn phải cày nhiều. Ngoài bài này bạn biết còn có bài nào nói về chủ đề truyền tham số thì cho tôi xin Links nhé.

 

[ndu96081631]

Cảm ơn Ndu ! đã hướng dẫn, đọc bài của bạn thì tôi đã hiểu sơ sơ và thấy cũng không quá khó nhưng để tự làm được chắc còn phải cày nhiều. Ngoài bài này bạn biết còn có bài nào nói về chủ đề truyền tham số thì cho tôi xin Links nhé.

Code dạng này em viết nhiều lắm anh à (những cái có liên quan đến lọc).. Chẳng hạn là đây:
http://www.giaiphapexcel.com/forum/...danh-sách-phòng-thi-theo-dữ-liệu-có-sẵn/page2
http://www.giaiphapexcel.com/forum/showthread.php?41657-Xếp-chuỗi-các-cột.
http://www.giaiphapexcel.com/forum/showthread.php?461-Sắp-xếp-các-Sheet-Bài-toán-sắp-xếp
http://www.giaiphapexcel.com/forum/showthread.php?25782-Duyệt-file-Excel-trong-sub-folder
http://www.giaiphapexcel.com/forum/...-bạn-luyện-tập-nhẹ-với-bài-toán-ABCDE-FGHIJ-9
................................
vân vân và vân vân