So sánh dữ liệu và xóa các mã hàng con

Liên hệ QC

vinh12tn

Thành viên mới
Tham gia
19/5/13
Bài viết
22
Được thích
0
Xin giúp đỡ
Tất cả các dòng có dữ liệu đầu A (cột H) giống nhau sẽ dùng để so sánh với nhau.
- chỉ giữ lại những mã hàng có dữ liệu đầu B lớn nhất, ví dụ mã hàng 8211560262 có dữ liệu đầu B là V78, O0Q,O1Q và mã hàng 8211560292 có dữ liệu đầu B là con của mã hàng 8211560262 thì xóa bỏ mã hàng 262. còn nếu 2 mã hàng khác bất kỳ dữ liệu nào ở đầu B thì phải giữ lại toàn bộ cả 2 mã mã hàng đó. Làm lần lượt như vậy cho mỗi loại ở đầu A. xin Cám ơn
 

File đính kèm

  • file.xlsx
    147.1 KB · Đọc: 10
Xin giúp đỡ
Tất cả các dòng có dữ liệu đầu A (cột H) giống nhau sẽ dùng để so sánh với nhau.
- chỉ giữ lại những mã hàng có dữ liệu đầu B lớn nhất, ví dụ mã hàng 8211560262 có dữ liệu đầu B là V78, O0Q,O1Q và mã hàng 8211560292 có dữ liệu đầu B là con của mã hàng 8211560262 thì xóa bỏ mã hàng 262. còn nếu 2 mã hàng khác bất kỳ dữ liệu nào ở đầu B thì phải giữ lại toàn bộ cả 2 mã mã hàng đó. Làm lần lượt như vậy cho mỗi loại ở đầu A. xin Cám ơn
Không hiểu!!!
Viết code theo kiểu thầy bói đoán voi
Mã:
Sub LubgTung()
  Dim sArr(), Res(), Arr(), iKey$, Ma$, dauA$, id$
  Dim i&, j&, k&, sRow&
  With Sheets("BONDER")
    sArr = .Range("A1", .Range("L" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Arr(1 To sRow)
  With CreateObject("scripting.dictionary")
    For i = sRow To 1 Step -1
      If Ma <> sArr(i, 1) Then
        If Len(iKey) > 0 Then
          If .exists(iKey) = False Then
            .Add iKey, id
            s = Split("," & id, ",")
            For j = 1 To UBound(s)
              k = k + 1
              Arr(k) = CLng(s(j))
            Next j
          End If
        End If
        id = i
        Ma = sArr(i, 1)
        iKey = sArr(i, 9)
      Else
        iKey = iKey & "#" & sArr(i, 9)
        id = id & "," & i
      End If
      If dauA <> sArr(i, 8) Then
        dauA = sArr(i, 8)
        .RemoveAll
      End If
    Next i
  End With
  
    ReDim Res(1 To k, 1 To 12)
    For i = k To 1 Step -1
      ik = Arr(i)
      For j = 1 To 12
        Res(k - i + 1, j) = sArr(ik, j)
      Next j
    Next i

  Sheets("BONDER").Range("N2").Resize(k).NumberFormat = "@"
  Sheets("BONDER").Range("N2").Resize(k, 12) = Res
End Sub
 
Upvote 0
Không hiểu!!!
Viết code theo kiểu thầy bói đoán voi
Mã:
Sub LubgTung()
  Dim sArr(), Res(), Arr(), iKey$, Ma$, dauA$, id$
  Dim i&, j&, k&, sRow&
  With Sheets("BONDER")
    sArr = .Range("A1", .Range("L" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Arr(1 To sRow)
  With CreateObject("scripting.dictionary")
    For i = sRow To 1 Step -1
      If Ma <> sArr(i, 1) Then
        If Len(iKey) > 0 Then
          If .exists(iKey) = False Then
            .Add iKey, id
            s = Split("," & id, ",")
            For j = 1 To UBound(s)
              k = k + 1
              Arr(k) = CLng(s(j))
            Next j
          End If
        End If
        id = i
        Ma = sArr(i, 1)
        iKey = sArr(i, 9)
      Else
        iKey = iKey & "#" & sArr(i, 9)
        id = id & "," & i
      End If
      If dauA <> sArr(i, 8) Then
        dauA = sArr(i, 8)
        .RemoveAll
      End If
    Next i
  End With

    ReDim Res(1 To k, 1 To 12)
    For i = k To 1 Step -1
      ik = Arr(i)
      For j = 1 To 12
        Res(k - i + 1, j) = sArr(ik, j)
      Next j
    Next i

  Sheets("BONDER").Range("N2").Resize(k).NumberFormat = "@"
  Sheets("BONDER").Range("N2").Resize(k, 12) = Res
End Sub
Không hiểu!!!
Viết code theo kiểu thầy bói đoán voi
Mã:
Sub LubgTung()
  Dim sArr(), Res(), Arr(), iKey$, Ma$, dauA$, id$
  Dim i&, j&, k&, sRow&
  With Sheets("BONDER")
    sArr = .Range("A1", .Range("L" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Arr(1 To sRow)
  With CreateObject("scripting.dictionary")
    For i = sRow To 1 Step -1
      If Ma <> sArr(i, 1) Then
        If Len(iKey) > 0 Then
          If .exists(iKey) = False Then
            .Add iKey, id
            s = Split("," & id, ",")
            For j = 1 To UBound(s)
              k = k + 1
              Arr(k) = CLng(s(j))
            Next j
          End If
        End If
        id = i
        Ma = sArr(i, 1)
        iKey = sArr(i, 9)
      Else
        iKey = iKey & "#" & sArr(i, 9)
        id = id & "," & i
      End If
      If dauA <> sArr(i, 8) Then
        dauA = sArr(i, 8)
        .RemoveAll
      End If
    Next i
  End With

    ReDim Res(1 To k, 1 To 12)
    For i = k To 1 Step -1
      ik = Arr(i)
      For j = 1 To 12
        Res(k - i + 1, j) = sArr(ik, j)
      Next j
    Next i

  Sheets("BONDER").Range("N2").Resize(k).NumberFormat = "@"
  Sheets("BONDER").Range("N2").Resize(k, 12) = Res
End Sub
dạ em có thử chạy chạy code kết quả cho ra đúng được ở dữ lieu đầu A thứ nhất, đến dữ lieu đầu A thứ 2 thì bị sai. em có gửi file chú thích, có gì anh kiểm tra rồi giúp em chỉnh sửa thêm một chút nữa nha anh. cám ơn anh
 

File đính kèm

  • file (1).xlsm
    174.3 KB · Đọc: 6
Upvote 0
dạ em có thử chạy chạy code kết quả cho ra đúng được ở dữ lieu đầu A thứ nhất, đến dữ lieu đầu A thứ 2 thì bị sai. em có gửi file chú thích, có gì anh kiểm tra rồi giúp em chỉnh sửa thêm một chút nữa nha anh. cám ơn anh
Thử
Mã:
Sub LungTungRoi()
  Dim sArr(), Res(), Arr(), iD(), S, tmp As Variant
  Dim iKey$, Ma$, dauA$
  Dim i&, j&, j2&, n&, m&, k&, ik&, sRow&, bl As Boolean
 
  With Sheets("BONDER")
    sArr = .Range("A1", .Range("L" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Arr(1 To sRow)
  n = 0
  dauA = sArr(sRow, 8)
  For i = sRow To 2 Step -1
    If Ma <> sArr(i, 1) Then
      Ma = sArr(i, 1)
      n = n + 1 'Thu tu ma
      ReDim Preserve Arr(1 To n)
      Arr(n) = Array("," & i, "," & sArr(i, 9))
    Else
      Arr(n)(0) = Arr(n)(0) & "," & i
      Arr(n)(1) = Arr(n)(1) & "," & sArr(i, 9)
    End If
    
    If dauA <> sArr(i - 1, 8) Then
      For j = n To 1 Step -1 ' thu tu ma
        S = Split(Arr(j)(1), ",")
        For j2 = 1 To n
          If j <> j2 And TypeName(Arr(j2)) = "Variant()" Then
            If UBound(Split(Arr(j2)(1), ",")) >= UBound(S) Then ' so dong >=
              bl = True
              tmp = Arr(j2)(1) & ","
              For m = 1 To UBound(S)
                If InStr(1, tmp, "," & S(m) & ",") = 0 Then bl = False: Exit For
              Next m
              If bl = True Then Arr(j) = "": Exit For
            End If
          End If
        Next j2
      Next j
      For j = n To 1 Step -1
        If TypeName(Arr(j)) = "Variant()" Then
          S = Split(Arr(j)(0), ",")
          For m = 1 To UBound(S)
            k = k + 1
            ReDim Preserve iD(1 To k)
            iD(k) = CLng(S(m))
          Next m
        End If
      Next j
      dauA = sArr(i - 1, 8)
      ReDim Arr(1 To 1)
      n = 0
    End If
  Next i
 
    ReDim Res(1 To k, 1 To 12)
    For i = k To 1 Step -1
      ik = iD(i)
      For j = 1 To 12
        Res(k - i + 1, j) = sArr(ik, j)
      Next j
    Next i

  Sheets("BONDER").Range("N2").Resize(k).NumberFormat = "@"
  Sheets("BONDER").Range("N2").Resize(k, 12) = Res
End Sub
 
Upvote 0
Thử
Mã:
Sub LungTungRoi()
  Dim sArr(), Res(), Arr(), iD(), S, tmp As Variant
  Dim iKey$, Ma$, dauA$
  Dim i&, j&, j2&, n&, m&, k&, ik&, sRow&, bl As Boolean

  With Sheets("BONDER")
    sArr = .Range("A1", .Range("L" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Arr(1 To sRow)
  n = 0
  dauA = sArr(sRow, 8)
  For i = sRow To 2 Step -1
    If Ma <> sArr(i, 1) Then
      Ma = sArr(i, 1)
      n = n + 1 'Thu tu ma
      ReDim Preserve Arr(1 To n)
      Arr(n) = Array("," & i, "," & sArr(i, 9))
    Else
      Arr(n)(0) = Arr(n)(0) & "," & i
      Arr(n)(1) = Arr(n)(1) & "," & sArr(i, 9)
    End If
   
    If dauA <> sArr(i - 1, 8) Then
      For j = n To 1 Step -1 ' thu tu ma
        S = Split(Arr(j)(1), ",")
        For j2 = 1 To n
          If j <> j2 And TypeName(Arr(j2)) = "Variant()" Then
            If UBound(Split(Arr(j2)(1), ",")) >= UBound(S) Then ' so dong >=
              bl = True
              tmp = Arr(j2)(1) & ","
              For m = 1 To UBound(S)
                If InStr(1, tmp, "," & S(m) & ",") = 0 Then bl = False: Exit For
              Next m
              If bl = True Then Arr(j) = "": Exit For
            End If
          End If
        Next j2
      Next j
      For j = n To 1 Step -1
        If TypeName(Arr(j)) = "Variant()" Then
          S = Split(Arr(j)(0), ",")
          For m = 1 To UBound(S)
            k = k + 1
            ReDim Preserve iD(1 To k)
            iD(k) = CLng(S(m))
          Next m
        End If
      Next j
      dauA = sArr(i - 1, 8)
      ReDim Arr(1 To 1)
      n = 0
    End If
  Next i

    ReDim Res(1 To k, 1 To 12)
    For i = k To 1 Step -1
      ik = iD(i)
      For j = 1 To 12
        Res(k - i + 1, j) = sArr(ik, j)
      Next j
    Next i

  Sheets("BONDER").Range("N2").Resize(k).NumberFormat = "@"
  Sheets("BONDER").Range("N2").Resize(k, 12) = Res
End Sub
Dạ em cám ơn nhiều
 
Upvote 0
Web KT
Back
Top Bottom