Chỉnh sửa giúp VBA lọc dữ liệu trùng (1 người xem)

[phanluan@gmail]

Chào mọi người,
Em xin nhờ cao nhân chỉnh sửa giúp file VBA với ah.
Số liệu đầu vào e để ở sheet 2, tới dòng 3137.
Số liệu cần xuất ra e để ở Sheet tổng hợp, nhưng khi xuất thì e thấy nó ko lọc hết dữ liệu ở sheet 2.

Bác nào chỉnh giúp em với ah.
Em cảm ơn cả nhà rất nhiều.

 

[CHAOQUAY]

Chào mọi người,
Em xin nhờ cao nhân chỉnh sửa giúp file VBA với ah.
Số liệu đầu vào e để ở sheet 2, tới dòng 3137.
Số liệu cần xuất ra e để ở Sheet tổng hợp, nhưng khi xuất thì e thấy nó ko lọc hết dữ liệu ở sheet 2.

Bác nào chỉnh giúp em với ah.
Em cảm ơn cả nhà rất nhiều.

Bạn muốn liệt kê tất cả các loại thép trong sheet1-sheet3?

 

[PacificPR]

Chào mọi người,
Em xin nhờ cao nhân chỉnh sửa giúp file VBA với ah.
Số liệu đầu vào e để ở sheet 2, tới dòng 3137.
Số liệu cần xuất ra e để ở Sheet tổng hợp, nhưng khi xuất thì e thấy nó ko lọc hết dữ liệu ở sheet 2.

Bác nào chỉnh giúp em với ah.
Em cảm ơn cả nhà rất nhiều.

Bạn Copy dữ liệu qua Sheet("Tonghop') rồi dùng RemoveDuplicates 1 phát là xong. Khỏi phải Câu két chi cho mệt

 

[phanluan@gmail]

Bạn Copy dữ liệu qua Sheet("Tonghop') rồi dùng RemoveDuplicates 1 phát là xong. Khỏi phải Câu két chi cho mệt

e ko biết viết code VBA bác ơi, nếu được bác sửa giúp trong file VBA của e với. Em cảm ơn bác nhiều.

Bài đã được tự động gộp: 28/10/20

Bạn muốn liệt kê tất cả các loại thép trong sheet1-sheet3?

đúng rồi bác.

 

[Nhattanktnn]

Chào mọi người,
Em xin nhờ cao nhân chỉnh sửa giúp file VBA với ah.
Số liệu đầu vào e để ở sheet 2, tới dòng 3137.
Số liệu cần xuất ra e để ở Sheet tổng hợp, nhưng khi xuất thì e thấy nó ko lọc hết dữ liệu ở sheet 2.

Bác nào chỉnh giúp em với ah.
Em cảm ơn cả nhà rất nhiều.

Ơ bài của bạn sao lấy code người ta giúp cho @xuongrongdat

 

[phanluan@gmail]

Ơ bài của bạn sao lấy code người ta giúp cho @xuongrongdat

Da vâng. File Vba này e tải trên diên đàn này luôn ah.

 

[saobekhonglac]

Ơ bài của bạn sao lấy code người ta giúp cho @xuongrongdat

Chắc mượn xài tạm

 

[Nhattanktnn]

Chắc mượn xài tạm

Ý mình là không có vấn đề gì về việc copy code, nhưng mà bài bạn ấy với bài kia khác nhau. Đâu dùng được

 

[saobekhonglac]

Ý mình là không có vấn đề gì về việc copy code, nhưng mà bài bạn ấy với bài kia khác nhau. Đâu dùng được

Code đưa lên GPE thì mọi người sẽ dùng nếu họ thấy áp dụng được, kiểu như chia sẽ kiến thức thôi.

 

[PacificPR]

Da vâng. File Vba này e tải trên diên đàn này luôn ah.

Mình sửa tạm như vầy. Bạn xem thử

Public Sub sGpe()
    Dim Dic As Object, Ws As Worksheet
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Tong hop" Then
        sArr = Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp)).Value
        For I = 1 To UBound(sArr)
            If sArr(I, 1) <> Empty Then
                If Not Dic.Exists(sArr(I, 1)) Then
                    K = K + 1
                    Dic.Add sArr(I, 1), ""
                    dArr(K, 1) = sArr(I, 1)
                End If
            End If
        Next I
    End If
Next Ws
With Sheets("Tong hop")
    .Range("B2", Range("B" & Rows.Count).End(xlUp)).ClearContents
    .Range("B2").Resize(K) = dArr
    .Range("B2", Range("B" & Rows.Count).End(xlUp)).Sort Key1:=.Range("B2")
End With
Set Dic = Nothing
End Sub

 

[phanluan@gmail]

Ý mình là không có vấn đề gì về việc copy code, nhưng mà bài bạn ấy với bài kia khác nhau. Đâu dùng được

Mình dùng dc ban ah. Mà chỉ lọc dc 1 phần dư liệu ơ sheet 2 thôi ah. Minh đang muốn lọc toàn bộ (khoảng 3000 dòng) ơ sheet 2 đo ban.
Cảm ơn.

 

[PacificPR]

Mình dùng dc ban ah. Mà chỉ lọc dc 1 phần dư liệu ơ sheet 2 thôi ah. Minh đang muốn lọc toàn bộ (khoảng 3000 dòng) ơ sheet 2 đo ban.
Cảm ơn.

Ơ ơ bài 4 bẩu là Sheet1-Sheet3. Sao bây giờ lại mỗi Sheet2 vậy

 

[Nhattanktnn]

Mình dùng dc ban ah. Mà chỉ lọc dc 1 phần dư liệu ơ sheet 2 thôi ah. Minh đang muốn lọc toàn bộ (khoảng 3000 dòng) ơ sheet 2 đo ban.
Cảm ơn.

Mỗi sheet2 thôi nhá , không hỏi thêm nhá :

Sub LocLoaiTrung()
Dim Arr(), Dic As Object, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Sheets("Sheet2").Range("B4:B" & Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row).Value
For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> "" Then Dic.Item(Arr(I, 1)) = ""
Next
Sheets("Tong hop").Range("E2:E" & Rows.Count).ClearContents
Sheets("Tong hop").Range("E2").Resize(Dic.Count) = Application.Transpose(Dic.keys)
Set Dic = Nothing
End Sub

 

[Cu Tồ]

Ý mình là không có vấn đề gì về việc copy code, nhưng mà bài bạn ấy với bài kia khác nhau. Đâu dùng được

ý là bạn đó thấy gần giống và không muốn đưa dữ liệu lên nên lấy luôn bài của xuongrogndat làm mẫu

 

[saobekhonglac]

ý là bạn đó thấy gần giống và không muốn đưa dữ liệu lên nên lấy luôn bài của xuongrogndat làm mẫu

chắc vậy, hoặc là nhiều khi bạn bè của nhau.

 

[phanluan@gmail]

Mình sửa tạm như vầy. Bạn xem thử

Public Sub sGpe()
    Dim Dic As Object, Ws As Worksheet
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Tong hop" Then
        sArr = Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp)).Value
        For I = 1 To UBound(sArr)
            If sArr(I, 1) <> Empty Then
                If Not Dic.Exists(sArr(I, 1)) Then
                    K = K + 1
                    Dic.Add sArr(I, 1), ""
                    dArr(K, 1) = sArr(I, 1)
                End If
            End If
        Next I
    End If
Next Ws
With Sheets("Tong hop")
    .Range("B2", Range("B" & Rows.Count).End(xlUp)).ClearContents
    .Range("B2").Resize(K) = dArr
    .Range("B2", Range("B" & Rows.Count).End(xlUp)).Sort Key1:=.Range("B2")
End With
Set Dic = Nothing
End Sub

Mỗi sheet2 thôi nhá , không hỏi thêm nhá :

Sub LocLoaiTrung()
Dim Arr(), Dic As Object, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Sheets("Sheet2").Range("B4:B" & Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row).Value
For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> "" Then Dic.Item(Arr(I, 1)) = ""
Next
Sheets("Tong hop").Range("E2:E" & Rows.Count).ClearContents
Sheets("Tong hop").Range("E2").Resize(Dic.Count) = Application.Transpose(Dic.keys)
Set Dic = Nothing
End Sub

Cảm ơn 2 bác cao nhân, để e check thử rồi báo lại nha. Cảm ơn cả nhà nhiều ah.

Bài đã được tự động gộp: 28/10/20

chắc vậy, hoặc là nhiều khi bạn bè của nhau.

Em search trên GPE thấy file phù hợp rồi dùng thôi bác.

 

[PacificPR]

Cảm ơn 2 bác cao nhân, để e check thử rồi báo lại nha. Cảm ơn cả nhà nhiều ah.

Bài đã được tự động gộp: 28/10/20

Em search trên GPE thấy file phù hợp rồi dùng thôi bác.

Í mình không phải là "cao nhân" nhoé. Đã bẩu mỗi Sheets2 thì dùng RemoveDuplicates một nhát ăn ngay rồi mừ

 

[saobekhonglac]

Í mình không phải là "cao nhân" nhoé. Đã bẩu mỗi Sheets2 thì dùng RemoveDuplicates một nhát ăn ngay rồi mừ

Cao nhân là người cao ý mà.

 

[Nhattanktnn]

Í mình không phải là "cao nhân" nhoé. Đã bẩu mỗi Sheets2 thì dùng RemoveDuplicates một nhát ăn ngay rồi mừ

Cao răng thì có cao nhân thì không