Nhờ sửa giúp hàm gọi biến từ bên ngoài (1 người xem)

tuanhuycntt · 11/8/17

Đầu bài:
- Nhập dữ liệu tại Sheet8 từ cột [A : P] dữ liệu khá nhiều tầm 20000 dòng
- Lọc trùng và Copy các cột A, C, D, J, L chuyển sang Sheet6
- Lọc riêng dữ liệu bị trùng và chuyển sang Sheet7

Em đang dùng Marco ghi lại các thao tác làm và có sửa lại 1 chút code. Nhưng hiện đang mắc ở 1 chỗ em muốn tạo 1 Hàm XOA_DU_LIEU được gọi tên từ biến ngoài với biến tương ứng là các sheet vì Copy sang 2 Sheet khác nhau mà dùng 2 dòng lệnh dài như thế để xóa thì không tối ưu (mặc dù Code Marco xóa chưa được tối ưu cho lắm).
Em đã code thử mấy lần nhưng nó không hoạt động được.

Anh/chị/em GPE hỗ trợ giúp em sửa lỗi với ạ

Đoạn code như này:

PHP:

Sub LOC_TRUNG()

    'Sheet6.Range("A:AI").Clear
    Sheet8.Range("A:P").Copy Destination:=Sheet6.Range("A1")    'copy
    ActiveSheet.Range("A:P").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
   
Rem xóa
Call XOA_DU_LIEU()

End Sub
Sub XOA_DU_LIEU()

Dim SheetName As String
Dim ws As Worksheet

SheetName = Sheet6.Name
Debug.Print SheetName
Set ws = Worksheets(SheetName)
With ws
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:I").Select
    Selection.Delete Shift:=xlToLeft
End With

End Sub

tuanhuycntt · 11/8/17

Hiện em phát hiện thêm 1 lỗi nữa là khi trỏ chuột đang ở sheet5 thì câu lệnh trong XOA_DU_LIEU không tự động chuyển sang Sheet6.
Anh/Em hỗ trợ phân tích giúp em với ạ. Em gắn SheetName ở đầu Selection nó báo lỗi không được

tuanhuycntt · 11/8/17

Em tự code được đoạn mã này để fix lại lỗi ở trên. Các bác gợi ý giúp em với ạ. Mặc dù không tối ưu lắm

PHP:

    Dim A
    Set A = ActiveSheet         'gan A = Sheet hien tai
    Debug.Print (A.Name)
    
    Sheets(Sheet6.Name).Select  'chuyen con tro sang sheet6
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:I").Select
    Selection.Delete Shift:=xlToLeft
    Sheets(A.Name).Select       'cchuyen con tro sang sheet A

phulien1902 · 11/8/17

tuanhuycntt đã viết:
Đầu bài:
- Nhập dữ liệu tại Sheet8 từ cột [A : P] dữ liệu khá nhiều tầm 20000 dòng
- Lọc trùng và Copy các cột A, C, D, J, L chuyển sang Sheet6
- Lọc riêng dữ liệu bị trùng và chuyển sang Sheet7

Em đang dùng Marco ghi lại các thao tác làm và có sửa lại 1 chút code. Nhưng hiện đang mắc ở 1 chỗ em muốn tạo 1 Hàm XOA_DU_LIEU được gọi tên từ biến ngoài với biến tương ứng là các sheet vì Copy sang 2 Sheet khác nhau mà dùng 2 dòng lệnh dài như thế để xóa thì không tối ưu (mặc dù Code Marco xóa chưa được tối ưu cho lắm).
Em đã code thử mấy lần nhưng nó không hoạt động được.

Anh/chị/em GPE hỗ trợ giúp em sửa lỗi với ạ

Đoạn code như này:

PHP:

Sub LOC_TRUNG() 'Sheet6.Range("A:AI").Clear Sheet8.Range("A:P").Copy Destination:=Sheet6.Range("A1") 'copy ActiveSheet.Range("A:P").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes Rem xóa Call XOA_DU_LIEU() End Sub Sub XOA_DU_LIEU() Dim SheetName As String Dim ws As Worksheet SheetName = Sheet6.Name Debug.Print SheetName Set ws = Worksheets(SheetName) With ws Columns("B:B").Select Selection.Delete Shift:=xlToLeft Columns("D:H").Select Selection.Delete Shift:=xlToLeft Columns("E:E").Select Selection.Delete Shift:=xlToLeft Columns("F:I").Select Selection.Delete Shift:=xlToLeft End With End Sub

Bạn thay cả cụm:

PHP:

    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:I").Select
    Selection.Delete Shift:=xlToLeft

bằng:

PHP:

.Range("B:B,D:I").EntireColumn.Delete

Bạn xem việc xóa cột đã ổn chưa nhé.

tuanhuycntt · 11/8/17

phulien1902 đã viết:
Bạn thay cả cụm:

PHP:

Columns("B:B").Select Selection.Delete Shift:=xlToLeft Columns("D:H").Select Selection.Delete Shift:=xlToLeft Columns("E:E").Select Selection.Delete Shift:=xlToLeft Columns("F:I").Select Selection.Delete Shift:=xlToLeft

bằng:

PHP:

.Range("B:B,D:J").EntireColumn.Delete

Bạn xem việc xóa cột đã ổn chưa nhé.

E cảm ơn bác.

Bác bày giúp e cách làm theo yêu cầu này với ạ. E dùng function thì không đúng và Sub thì gán biến không được

tuanhuycntt đã viết:
Em đang dùng Marco ghi lại các thao tác làm và có sửa lại 1 chút code. Nhưng hiện đang mắc ở 1 chỗ em muốn tạo 1 Hàm XOA_DU_LIEU được gọi tên từ biến ngoài với biến tương ứng là các sheet vì Copy sang 2 Sheet khác nhau mà dùng 2 dòng lệnh dài như thế để xóa thì không tối ưu (mặc dù Code Marco xóa chưa được tối ưu cho lắm).
Em đã code thử mấy lần nhưng nó không hoạt động được.

ndu96081631 · 11/8/17

tuanhuycntt đã viết:
E cảm ơn bác.

Bác bày giúp e cách làm theo yêu cầu này với ạ. E dùng function thì không đúng và Sub thì gán biến không được

Bạn viết 1 sub có tham số truyền thế này:

Mã:

Private Sub DelColumns(ByVal Range As Range)
  Range.EntireColumn.Delete
End Sub

Xong! Giờ áp dụng, chẳng hạn muốn xóa cột D và G, vậy thì cứ truyền tham số Range("D: D, G:G") vào sub trên là được rồi:

Mã:

Sub Main()
  DelColumns Range("D:D,G:G")
End Sub

Vậy thôi!

HieuCD · 11/8/17

tuanhuycntt đã viết:
Đầu bài:
- Nhập dữ liệu tại Sheet8 từ cột [A : P] dữ liệu khá nhiều tầm 20000 dòng
- Lọc trùng và Copy các cột A, C, D, J, L chuyển sang Sheet6
- Lọc riêng dữ liệu bị trùng và chuyển sang Sheet7

Em đang dùng Marco ghi lại các thao tác làm và có sửa lại 1 chút code. Nhưng hiện đang mắc ở 1 chỗ em muốn tạo 1 Hàm XOA_DU_LIEU được gọi tên từ biến ngoài với biến tương ứng là các sheet vì Copy sang 2 Sheet khác nhau mà dùng 2 dòng lệnh dài như thế để xóa thì không tối ưu (mặc dù Code Marco xóa chưa được tối ưu cho lắm).
Em đã code thử mấy lần nhưng nó không hoạt động được.

Anh/chị/em GPE hỗ trợ giúp em sửa lỗi với ạ

Đoạn code như này:

PHP:

Sub LOC_TRUNG() 'Sheet6.Range("A:AI").Clear Sheet8.Range("A:P").Copy Destination:=Sheet6.Range("A1") 'copy ActiveSheet.Range("A:P").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes Rem xóa Call XOA_DU_LIEU() End Sub Sub XOA_DU_LIEU() Dim SheetName As String Dim ws As Worksheet SheetName = Sheet6.Name Debug.Print SheetName Set ws = Worksheets(SheetName) With ws Columns("B:B").Select Selection.Delete Shift:=xlToLeft Columns("D:H").Select Selection.Delete Shift:=xlToLeft Columns("E:E").Select Selection.Delete Shift:=xlToLeft Columns("F:I").Select Selection.Delete Shift:=xlToLeft End With End Sub

bạn thử với code

Mã:

Sub main()
  Call XoaCot("B:B,E:I,K:K,M:P")
End Sub
Sub XoaCot(ByVal Cols As String)
  With Sheet6
    .Range(Cols).EntireColumn.Delete
  End With
End Sub

VetMini · 12/8/17

HieuCD đã viết:
bạn thử với code

Mã:

Sub main() Call XoaCot("B:B,E:I,K:K,M:P") End Sub Sub XoaCot(ByVal Cols As String) With Sheet6 .Range(Cols).EntireColumn.Delete End With End Sub

Mã:

Chủ thớt muốn 2 sheets

Sub main()
  Call XoaCot(Sheet6.Name, "B:B,E:I,K:K,M:P")
  Call XoaCot(Sheet7.Name, "B:B,E:I,K:K,M:P")
End Sub
Sub XoaCot(ByVal sName As String, ByVal Cols As String)
  With Sheets(sName)
    .Range(Cols).EntireColumn.Delete
  End With
End Sub

tuanhuycntt · 12/8/17

em cảm ơn các bác đã giúp

Em code thử ntn các bác xem giúp em có cách nào hiệu quả hơn không ạ

PHP:

Sub LOC_TRUNG()
    Dim sCOT As Long
    sCOT = Sheet6.UsedRange.Columns.Count

    Sheet6.Range("A1:P20000").ClearContents
    Sheet8.Range("A:P").Copy Destination:=Sheet6.Range("A1")    'copy
    ActiveSheet.Range("A:P").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
    
Rem xóa
If Cells(1, 2).Value <> "src" Then
    Call XoaCot(Sheet6.Name, "B:B,D:J")
    Call XoaCot(Sheet6.Name, "E:H")
End If
If sCOT > 4 And Cells(1, sCOT).Value <> "disposition" Then
    Call XoaCot(Sheet6.Name, "E:H")
End If

End Sub

Sub XoaCot(ByVal sName As String, ByVal COT As String)
    With Sheets(sName)
        .Range(COT).EntireColumn.Delete
    End With
End Sub

ndu96081631 · 12/8/17

tuanhuycntt đã viết:

em cảm ơn các bác đã giúp

Em code thử ntn các bác xem giúp em có cách nào hiệu quả hơn không ạ

PHP:

Sub LOC_TRUNG()
    Dim sCOT As Long
    sCOT = Sheet6.UsedRange.Columns.Count

    Sheet6.Range("A1:P20000").ClearContents
    Sheet8.Range("A:P").Copy Destination:=Sheet6.Range("A1")    'copy
    ActiveSheet.Range("A:P").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
  
Rem xóa
If Cells(1, 2).Value <> "src" Then
    Call XoaCot(Sheet6.Name, "B:B,D:J")
    Call XoaCot(Sheet6.Name, "E:H")
End If
If sCOT > 4 And Cells(1, sCOT).Value <> "disposition" Then
    Call XoaCot(Sheet6.Name, "E:H")
End If

End Sub

Sub XoaCot(ByVal sName As String, ByVal COT As String)
    With Sheets(sName)
        .Range(COT).EntireColumn.Delete
    End With
End Sub

Hiệu quả hay không là do bạn tự kiểm tra và cảm nhận!
Có điều tôi thắc mắc tại sao bạn không dùng code:

Mã:

Private Sub DelColumns(ByVal Range As Range)
  Range.EntireColumn.Delete
End Sub

cho khỏe, vì chỉ cần truyền 1 đối số duy nhất? Nên biết là Range as Range có nghĩa là bạn truyền vào không có tên sheet thì nó tự hiểu đó là ActiveSheet, còn nếu bạn ghi rõ sheet nào thì nó sẽ xóa chính xác tại sheet đó. Ví dụ:

Mã:

  DelColumns Sheet6.Range("E:H")

Có phải là thoải mái hơn không? Truyền chi 2, 3 tham số vào cho.. thừa
Range thì cứ truyền đúng là Range. Quan điểm của tôi là không nên lòng vòng!

tuanhuycntt · 12/8/17

ndu96081631 đã viết:
Hiệu quả hay không là do bạn tự kiểm tra và cảm nhận!
Có điều tôi thắc mắc tại sao bạn không dùng code:

Mã:

Private Sub DelColumns(ByVal Range As Range) Range.EntireColumn.Delete End Sub

cho khỏe, vì chỉ cần truyền 1 đối số duy nhất? Nên biết là Range as Range có nghĩa là bạn truyền vào không có tên sheet thì nó tự hiểu đó là ActiveSheet, còn nếu bạn ghi rõ sheet nào thì nó sẽ xóa chính xác tại sheet đó. Ví dụ:

Mã:

DelColumns Sheet6.Range("E:H")

Có phải là thoải mái hơn không? Truyền chi 2, 3 tham số vào cho.. thừa
Range thì cứ truyền đúng là Range. Quan điểm của tôi là không nên lòng vòng!

Code của bác ngắn gọn và tối ưu thật nhưng tại e đọc code thấy hơi lạ và chưa hiểu được nghĩa hết của nó. Bác giải thích e hiểu thêm về truyền biến kiểu Range As Range rồi.
Em cảm ơn bác NDU.

Bác cho e hỏi thêm vấn đề này nữa.

Em viết Code để truyền biến là Sheet vào Sub LOC_TRUNG() nhưng khi chạy nó báo lỗi. E chưa hiểu cách fix kiểu gì. Liệu rằng kiểu Range As Range có thể sửa thành dạng nào đó để truyền biến dạng SHEET không ạ? (không cần phải nhập tên Sheet mà chỉ cần nhập Sheet6 hoặc Sheet7)

VD:

PHP:

Sub Main()
 LOC_TRUNG (Sheet6)
 LOC_TRUNG (Sheet7)
End Sub

Sub LOC_TRUNG(X)
 .....code.....
End Sub

ndu96081631 · 12/8/17

tuanhuycntt đã viết:
Bác cho e hỏi thêm vấn đề này nữa.

Em viết Code để truyền biến là Sheet vào Sub LOC_TRUNG() nhưng khi chạy nó báo lỗi. E chưa hiểu cách fix kiểu gì. Liệu rằng kiểu Range As Range có thể sửa thành dạng nào đó để truyền biến dạng SHEET không ạ? (không cần phải nhập tên Sheet mà chỉ cần nhập Sheet6 hoặc Sheet7)

VD:

PHP:

Sub Main() LOC_TRUNG (Sheet6) LOC_TRUNG (Sheet7) End Sub Sub LOC_TRUNG(X) .....code..... End Sub

Dù bạn lọc cái gì thì cũng phải có vùng dữ liệu cụ thể chứ không lý nào lọc tất tần tật mọi thứ trong 1 sheet, đúng không? Vậy tôi sẽ viết code lọc trùng tương tự như cách viết trước:

Mã:

Private Sub UniqueData(ByVal SourceRange As Range)
  Dim lCols As Long, n As Long
  lCols = SourceRange.Columns.Count
  ReDim aCols(lCols - 1)
  For n = 1 To lCols
     aCols(n - 1) = n
  Next
  SourceRange.RemoveDuplicates aCols, xlYes
End Sub

Khi áp dụng, bạn chỉ cần truyền vùng dữ liệu chỉ định vào là được rồi, ví dụ chỉ 1 dòng lệnh:

Mã:

UniqueData Sheet6.Range("A:P")

tuanhuycntt · 12/8/17

Dear Bác NDU

Em giúp em đoạn code này với ạ. Em chưa hiểu lắm.

Mã:

  lCols = SourceRange.Columns.Count
  ReDim aCols(lCols - 1)
  For n = 1 To lCols
     aCols(n - 1) = n
  Next
  SourceRange.RemoveDuplicates aCols, xlYes
End Sub

lệnh ReDim aCols(lCols - 1) được hiểu như nào vậy bác?

ndu96081631 · 12/8/17

tuanhuycntt đã viết:
lệnh ReDim aCols(lCols - 1) được hiểu như nào vậy bác?

Lệnh để tạo mảng thôi mà. Thay vì bạn phải ghi:
RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
Giờ bạn truyền đối số là 1 vùng chỉ định nào đó thì ai mà biết chỗ màu đỏ ở trên phải ghi Array(1,... đến bao nhiêu)
Vậy nên ta cho mọi thứ "động" luôn, số cột của dữ liệu là bao nhiêu thì aCols sẽ tạo ra Array đúng bấy nhiêu

tuanhuycntt · 12/8/17

Bác cho e hỏi 2 dòng lệnh này
SourceRange.Columns.Count
UsedRange.Columns.Count
có phải đều có nghĩa tương đương nhau là đếm số cột của vùng chứa dữ liệu?

ndu96081631 · 12/8/17

tuanhuycntt đã viết:
Bác cho e hỏi 2 dòng lệnh này
SourceRange.Columns.Count
UsedRange.Columns.Count
có phải đều có nghĩa tương đương nhau là đếm số cột của vùng chứa dữ liệu?

SourceRange.Columns.Count là tổng số cột của SourceRange
UsedRange.Columns.Count là tổng số cột của toàn bộ dữ liệu trên sheet

tuanhuycntt · 12/8/17

Em cảm ơn bác NDU.
Mọi vấn về khó em đã được gỡ rối bác Close Topic giúp em với ạ

Tiện thể bác qua xem giúp em file của chương trình này em đang up ở post dưới.

Gán vào Button thì dòng lệnh không hoạt động

Hiện code có khả năng bị lỗi nhưng e vẫn chưa tìm được nguyên nhân ở đâu.

ndu96081631 · 12/8/17

tuanhuycntt đã viết:
Em cảm ơn bác NDU.
Mọi vấn về khó em đã được gỡ rối bác Close Topic giúp em với ạ

Sao lại Close? Việc bạn tuy đã xong nhưng vẫn có người muốn tìm hiểu thì sao?

tuanhuycntt đã viết:
Tiện thể bác qua xem giúp em file của chương trình này em đang up ở post dưới.
Gán vào Button thì dòng lệnh không hoạt động
Hiện code có khả năng bị lỗi nhưng e vẫn chưa tìm được nguyên nhân ở đâu.

Bên đó có bao nhiêu người giúp bạn rồi còn gì

befaint · 12/8/17

tuanhuycntt đã viết:
Mọi vấn về khó em đã được gỡ rối bác Close Topic giúp em với ạ

?

tuanhuycntt · 12/8/17

befaint đã viết:
?

Ý em là bác khoá lại bài viết này chỉ để dạng view và ko cho ai reply nữa ý ạ

Nhờ sửa giúp hàm gọi biến từ bên ngoài (1 người xem)

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

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

GPE - My love

Thành viên chính thức

Huyền thoại GPE

Chuyên gia GPE

Đang đi tìm hòn đá

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

|||||||||||||

Thành viên chính thức

Sinh nhật lần 19 GPE