Chỉnh sửa giúp VBA lọc dữ liệu trùng

phanluan@gmail · 26/10/20

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 · 26/10/20

phanluan@gmail đã viết:
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 · 26/10/20

phanluan@gmail đã viết:
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 · 28/10/20

PacificPR đã viết:
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

CHAOQUAY đã viết:
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 · 28/10/20

phanluan@gmail đã viết:
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 · 28/10/20

Nhattanktnn đã viết:
Ơ 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 · 28/10/20

Nhattanktnn đã viết:
Ơ 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 · 28/10/20

saobekhonglac đã viết:
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 · 28/10/20

Nhattanktnn đã viế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

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 · 28/10/20

phanluan@gmail đã viết:
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ử

PHP:

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 · 28/10/20

Nhattanktnn đã viế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

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 · 28/10/20

phanluan@gmail đã viết:
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 · 28/10/20

phanluan@gmail đã viết:
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á :

PHP:

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ồ · 28/10/20

Nhattanktnn đã viế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 · 28/10/20

Cu Tồ đã viết:
ý 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 · 28/10/20

PacificPR đã viết:

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

PHP:

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

Nhattanktnn đã viết:

Mỗi sheet2 thôi nhá

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

PHP:

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

saobekhonglac đã viết:
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 · 28/10/20

phanluan@gmail đã viết:
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 · 28/10/20

PacificPR đã viết:
Í 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 · 28/10/20

PacificPR đã viết:
Í 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

Chỉnh sửa giúp VBA lọc dữ liệu trùng

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên gắn bó

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên gắn bó