Xắp xếp dữ liệu

[PacificPR]

Em loai hoay mãi không nghĩ ra cách xắp xếp dữ liệu của danh mục biên bản nghiệm thu như trong Sheets("Danhmuc"). Nhờ Anh(Chị) xem và làm giúp em với. Cụ thể em ghi trong File đính kèm
Em cám ơn Anh(Chị) nhiều./

 

[dazkangel]

Em loai hoay mãi không nghĩ ra cách xắp xếp dữ liệu của danh mục biên bản nghiệm thu như trong Sheets("Danhmuc"). Nhờ Anh(Chị) xem và làm giúp em với. Cụ thể em ghi trong File đính kèm
Em cám ơn Anh(Chị) nhiều./

bạn nên tạo ra 1 bảng kết quả sắp xếp mẫu để tiện xử lý.

 

[PacificPR]

Mẫu thì cũng khó anh ạ. Cái mục biên bản kiểm tra và lấy mẫu là không cố định (vì nếu khối lượng nhỏ quá có thể bỏ qua không cần kiểm tra hoặc lấy mẫu). Em đang viết Code lấy ngược từ NTCV lên mà chưa ổn

 

[dazkangel]

Mẫu thì cũng khó anh ạ. Cái mục biên bản kiểm tra và lấy mẫu là không cố định (vì nếu khối lượng nhỏ quá có thể bỏ qua không cần kiểm tra hoặc lấy mẫu). Em đang viết Code lấy ngược từ NTCV lên mà chưa ổn

mình đang sử dụng điện thoại nên khá bất tiện, khi nào có thời gian tính tiếp, bạn có thể nhờ mấy anh chị khác hướng dẫn

 

[PacificPR]

mình đang sử dụng điện thoại nên khá bất tiện, khi nào có thời gian tính tiếp, bạn có thể nhờ mấy anh chị khác hướng dẫn

Da. Cám ơn anh nhiều. Khi nào rảnh mong anh và các anh chị giúp em nha

 

[PacificPR]

Các Thầy, Anh, Chị ngang qua giúp em với

 

[HieuCD]

không biết lấy ngày như thế nào nên bỏ qua cột ngày, bạn có thể tự thêm vào thử

Sub GPE()
Dim Darr(), Arr(), Sarr(), StrArr(), Laymau As String, Tmp As String
Dim i As Long, k As Long, j As Byte, iR As Byte, Stt As Integer
With Sheets("Nhattrinh")
  Darr = .Range("B17:E" & .Range("C17").End(xlDown).Row).Value
End With
ReDim Arr(1 To UBound(Darr) * 3, 1 To 4)
With Sheets("Danhmuc")
  StrArr = .Range("H1:H3").Value ' tam gan ky tu tieng viet co dau
  Laymau = .Range("H4").Value
End With
ReDim Sarr(1 To 100, 1 To 5)
For i = 1 To UBound(Darr)
  Tmp = Left(Darr(i, 1), 2)
  If Tmp = "TC" Or i = UBound(Darr) Then
    If Sarr(1, 1) <> "" Then
     
      For iR = 1 To Sarr(100, 1) 'cong viec
        Stt = Stt + 1
        k = k + 1
        Arr(k, 1) = Stt '
        For j = 1 To 3
         Arr(k, j + 1) = Darr(Sarr(iR, 1), j)
        Next j
        For j = 1 To 3
          k = k + 1
          Arr(k, 3) = StrArr(j, 1)
        Next j
      Next iR

      For iR = 1 To Sarr(100, 2) 'kiem tra
        k = k + 1
        Arr(k, 2) = Darr(Sarr(iR, 2), 1)
        Arr(k, 3) = Darr(Sarr(iR, 2), 2)
      Next iR
     
      For iR = 1 To Sarr(100, 3) 'mau thi nghiem
        k = k + 1
        Arr(k, 2) = Darr(Sarr(iR, 3), 1)
        Arr(k, 3) = Darr(Sarr(iR, 3), 2)
        k = k + 1
        Arr(k, 3) = Replace(Arr(k - 1, 3), Laymau, "    -KQTN")
      Next iR
     
      ReDim Sarr(1 To 100, 1 To 4)
    End If
  Else
'Sarr luu thu tu dòng cua Darr, cot 1 là cong viec, cot 2 là kiem tra, cot 3 là mau thi nghiem
' dong 100 cua Sarr luu so dong du lieu cua cot tuong ung
    If Tmp = "KT" Then
      Sarr(100, 2) = Sarr(100, 2) + 1
      Sarr(Sarr(100, 2), 2) = i
    ElseIf Tmp = "CP" Then
      Sarr(100, 3) = Sarr(100, 3) + 1
      Sarr(Sarr(100, 3), 3) = i
    ElseIf Tmp <> "" Then
      Sarr(100, 1) = Sarr(100, 1) + 1
      Sarr(Sarr(100, 1), 1) = i
    End If
  End If
Next i
If k Then Sheets("Danhmuc").Range("A5").Resize(k, 4) = Arr
End Sub[code]

 

[Ba Tê]

Các Thầy, Anh, Chị ngang qua giúp em với

Nhìn hoa mắt cũng không hiểu kết quả mẫu của bạn.
Mã AB.13111 phía dưới đâu có kèm mã KT và CP như mã AB.13111 phía trên ?
Phải là "sắp xếp" chứ sao lại "xắp xếp".

 

[PacificPR]

Cám ơn anh HieuCD và thầy Ba Tê nhiều. Em làm được rồi