Lọc ra đơn hàng không có bên bảng 2 (1 người xem)

[NguyenthiH]

Chào các anh chị, em có file, trong file có 2 bảng, mong các anh chị giúp em lọc ra những PO nào mà bảng 1 có mà bảng 2 không có ạ.

 

[ongke0711]

Trường hợp dã chiến, số dòng ít vậy thì làm cách thủ công, quét hết bảng, dùng Conditional Formating - Duplicate value là được rồi.

 

[NguyenthiH]

Cách làm làm sao anh? Em có vào Duplicate, nhưng nó không được.

 

[BuiQuangThuan]

Cách làm làm sao anh? Em có vào Duplicate, nhưng nó không được.

Ý của em là quét 2 bảng. chọn Conditional Formatting.cái nào trùng thì nổi lên. cái nào không trùng thì còn sót lại.

 

[NguyenthiH]

Lọc ra luôn dùm em ở bảng em có ghi chú đó ạ.

 

[batman1]

Công thức cho O2

=IF(COUNTIF($I$2:$M$26,A2),"",A2)

Kéo sang phải tới cột U rồi xuống dưới tới dòng cuối của bảng 1.
-------------
CF: chọn bảng 1 -> CF -> công thức

=COUNTIF($I$2:$M$26,A2)=0

-> chọn mầu.

 

[ongke0711]

Lọc ra luôn dùm em ở bảng em có ghi chú đó ạ.

Kinh nhể...hehe mù VBA mà cứ thích xài VBA.

 

[NguyenthiH]

Dạ em cám ơn Thầy batman1, anh ongke0711.
Em có biết gì đâu, toàn nhờ Thầy, các anh chị trên DD giúp không à.

 

[vanaccex]

Chào các anh chị, em có file, trong file có 2 bảng, mong các anh chị giúp em lọc ra những PO nào mà bảng 1 có mà bảng 2 không có ạ.

Bạn có thể sử dụng VBA với 2 Function được viết trên diễn đàn

Sub SoSanh()
  Dim sArray1, sArray2, Arr, TG As Double

  sArray1 = JoinColunm(Range("C2:G16"))
  sArray2 = JoinColunm(Range("I2:M16"))
  Arr = Compare2List(sArray1, sArray2, 2)
  Range("O2").Resize(UBound(Arr, 1)).Value = Arr

End Sub
' Ham duoc viet boi ??ö??ß?†?†µ? giaiphapexcel.com
Function JoinColunm(ParamArray Table_Array())
    Dim Tmp, Item, Arr(), n As Long, i As Long
On Error Resume Next
For i = LBound(Table_Array) To UBound(Table_Array)
    Tmp = Table_Array(i)
    If TypeOf Table_Array(i) Is Range Then
        For Each Item In Tmp
            If Item <> Empty Then
                n = n + 1
                ReDim Preserve Arr(1 To n)
                Arr(n) = Item
            End If
        Next
    Else
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Table_Array(i)
    End If
Next i
JoinColunm = WorksheetFunction.Transpose(Arr)
End Function
' Ham duoc viet boi anhtuan1066 dien dan giaiphapexcel.com
Function Compare2List(ByVal sArray1, ByVal sArray2, ByVal CompareMod As Long)
  Dim Dic1, Dic2, Item, Item1, Item2, TmpKeys1, TmpKeys2, Arr() As String
  Dim Tmp1 As String, Tmp2 As String, j As Long, ub As Long
  On Error Resume Next
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  For Each Item1 In sArray1
    If CStr(Item1) <> "" Then
      Tmp1 = CStr(Item1)
      If Not Dic1.Exists(Tmp1) Then Dic1.Add Tmp1, ""
    End If
  Next
  TmpKeys1 = Dic1.Keys
  For Each Item2 In sArray2
    If CStr(Item2) <> "" Then
      Tmp2 = CStr(Item2)
      If Not Dic2.Exists(Tmp2) Then Dic2.Add Tmp2, ""
    End If
  Next
  TmpKeys2 = Dic2.Keys
  ub = IIf(Dic1.Count > Dic2.Count, Dic1.Count, Dic2.Count)
  ReDim Arr(1 To ub, 1 To 1)
  Select Case CompareMod
    Case 1
      For Each Item In TmpKeys1
        If Dic2.Exists(CStr(Item)) Then
          j = j + 1
          Arr(j, 1) = CStr(Item)
        End If
      Next
    Case 2
      For Each Item In TmpKeys1
        If Not Dic2.Exists(CStr(Item)) Then
          j = j + 1
          Arr(j, 1) = CStr(Item)
        End If
      Next
    Case 3
      For Each Item In TmpKeys2
        If Not Dic1.Exists(CStr(Item)) Then
          j = j + 1
          Arr(j, 1) = CStr(Item)
        End If
      Next
  End Select
  Compare2List = Arr
End Function

 

[HieuCD]

Chào các anh chị, em có file, trong file có 2 bảng, mong các anh chị giúp em lọc ra những PO nào mà bảng 1 có mà bảng 2 không có ạ.

Chạy code

Sub LocDuLieuKhongTrung()
  Dim Rng As Range, Rng2 As Range, fRes As Range, Res()
  Dim sRow&, sCol&, sRow2&, sCol2&, i&, j&, k&, c&, iKey$
 
  Application.DisplayAlerts = False
  On Error Resume Next
Bang1:
  Set Rng = Application.InputBox("Chon Bang 1", Type:=8)
  If Rng Is Nothing Then MsgBox ("Phai chon Bang 1"): GoTo Bang1
  sRow = Rng.Rows.Count
  sCol = Rng.Columns.Count
Bang2:
  Set Rng2 = Application.InputBox("Chon Bang 2", Type:=8)
  If Rng2 Is Nothing Then MsgBox ("Phai chon Bang 2"): GoTo Bang2
  sRow2 = Rng2.Rows.Count
  sCol2 = Rng2.Columns.Count
KetQua:
  Set fRes = Application.InputBox("Chon Cell tra ket qua", Type:=8)
  If fRes Is Nothing Then MsgBox ("Phai chon Cell tra ket qua"): GoTo KetQua
  On Error GoTo 0
  ReDim Res(1 To sRow, 1 To sCol)
  With CreateObject("scripting.dictionary")
    For i = 1 To sRow2
      For j = 1 To sCol2
        iKey = Rng2(i, j)
        If iKey <> Empty Then .Item(iKey) = ""
      Next j
    Next i
    c = 1
    For i = 1 To sRow
      For j = 1 To sCol
        iKey = Rng(i, j)
        If iKey <> Empty Then
          If .exists(iKey) = False Then
            If k < sRow Then
              k = k + 1
            Else
              k = 1
              c = c + 1
            End If
            Res(k, c) = Rng(i, j)
          End If
        End If
      Next j
    Next i
  End With
  fRes.Resize(sRow, c) = Res
  Application.DisplayAlerts = True
End Sub

 

[NguyenthiH]

Cám ơn anh Hiếu nhiều, nhưng xin anh chỉnh code cho các PO nằm liền nhau thì cứ giữ nguyên như vậy.
Ví dụ trong bảng 1 có

Bảng 1	Sau khi lọc thì có	Mong anh chỉnh cho đúng theo thứ tự bên bảng 1 dùm ạ
PO30414	PO30414
PO30415	PO32280
PO32280	PO30415
PO32282	PO32282

 

[phulien1902]

Công thức cho O2

=IF(COUNTIF($I$2:$M$26,A2),"",A2)

Kéo sang phải tới cột U rồi xuống dưới tới dòng cuối của bảng 1.
-------------
CF: chọn bảng 1 -> CF -> công thức

=COUNTIF($I$2:$M$26,A2)=0

-> chọn mầu.

Ngon, bổ, rẻ là đây!

 

[VetMini]

Kinh nhể...hehe mù VBA mà cứ thích xài VBA.

Mù đâu có bị cấm thích?
Miễn là có chột sẵn sàng dắt đường thì cứ việc tiến tới.

Mà diễn đàn này thiếu gì người sẵn sàng.

 

[HieuCD]

Cám ơn anh Hiếu nhiều, nhưng xin anh chỉnh code cho các PO nằm liền nhau thì cứ giữ nguyên như vậy.
Ví dụ trong bảng 1 có

Bảng 1	Sau khi lọc thì có	Mong anh chỉnh cho đúng theo thứ tự bên bảng 1 dùm ạ
PO30414	PO30414
PO30415	PO32280
PO32280	PO30415
PO32282	PO32282

Thay đổi thứ tự 2 vòng For i và For j

Sub LocDuLieuKhongTrung()
  Dim Rng As Range, Rng2 As Range, fRes As Range, Res()
  Dim sRow&, sCol&, sRow2&, sCol2&, i&, j&, k&, c&, iKey$
 
  Application.DisplayAlerts = False
  On Error Resume Next
Bang1:
  Set Rng = Application.InputBox("Chon Bang 1", Type:=8)
  If Rng Is Nothing Then MsgBox ("Phai chon Bang 1"): GoTo Bang1
  sRow = Rng.Rows.Count
  sCol = Rng.Columns.Count
Bang2:
  Set Rng2 = Application.InputBox("Chon Bang 2", Type:=8)
  If Rng2 Is Nothing Then MsgBox ("Phai chon Bang 2"): GoTo Bang2
  sRow2 = Rng2.Rows.Count
  sCol2 = Rng2.Columns.Count
KetQua:
  Set fRes = Application.InputBox("Chon Cell tra ket qua", Type:=8)
  If fRes Is Nothing Then MsgBox ("Phai chon Cell tra ket qua"): GoTo KetQua
  On Error GoTo 0
  ReDim Res(1 To sRow, 1 To sCol)
  With CreateObject("scripting.dictionary")
    For i = 1 To sRow2
      For j = 1 To sCol2
        iKey = Rng2(i, j)
        If iKey <> Empty Then .Item(iKey) = ""
      Next j
    Next i
    c = 1
    For j = 1 To sCol
      For i = 1 To sRow
        iKey = Rng(i, j)
        If iKey <> Empty Then
          If .exists(iKey) = False Then
            If k < sRow Then
              k = k + 1
            Else
              k = 1
              c = c + 1
            End If
            Res(k, c) = Rng(i, j)
          End If
        End If
      Next i
    Next j
  End With
  fRes.Resize(sRow, c) = Res
  Application.DisplayAlerts = True
End Sub

 

[NguyenthiH]

Cám ơn anh Hiếu nhiều!!!!