Xuất dữ liệu có điều kiện

[BuiQuangThuan]

Gửi các thầy cô ạ
Hiện tại em đang có file dữ liệu phải làm thủ công.
Trên file có 2 sheet
Sheet DATA & FORM (file đính kèm)
Trên sheet DATA: Em muốn chuyển dữ liệu như hình:
Sau đó em muốn dùng vòng lặp chuyển dữ liệu sang sheet FORM như hình

Khi đủ số lượng 10 nhãn rồi thì in ra và tiếp tục lấy dữ liệu tiếp.
Do vẫn kém. Nên em chưa làm được. Nhờ các thầy cô giúp hoặc tư vấn cách nào hay hơn không với ạ
Em cám ơn

 

[HieuCD]

Gửi các thầy cô ạ
Hiện tại em đang có file dữ liệu phải làm thủ công.
Trên file có 2 sheet
Sheet DATA & FORM (file đính kèm)
Trên sheet DATA: Em muốn chuyển dữ liệu như hình:View attachment 230486
Sau đó em muốn dùng vòng lặp chuyển dữ liệu sang sheet FORM như hình
View attachment 230487
Khi đủ số lượng 10 nhãn rồi thì in ra và tiếp tục lấy dữ liệu tiếp.
Do vẫn kém. Nên em chưa làm được. Nhờ các thầy cô giúp hoặc tư vấn cách nào hay hơn không với ạ
Em cám ơn

Thử code

Sub InNhan()
  Dim sArr(), S, tmp$
  Dim sRow&, r&, c&, i&, j&, k&, fR&, eR&, N&, Lot$

  With Sheets("NGUON")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A2:B" & i).Value
  End With
  sRow = UBound(sArr)
  N = 0: r = -7
  With Sheets("FORM")
    For i = 1 To sRow
      Lot = sArr(i, 1)
      tmp = Replace(sArr(i, 2), " ", "")
      If InStr(1, tmp, "-") = 0 Then tmp = tmp & "-" & tmp
      S = Split(tmp, "-")
      fR = CLng(S(0))
      eR = CLng(S(1))
      For j = fR To eR
        If N = 0 Then
          For k = 1 To 5
            r = r + 14
            Cells(r, 1).Resize(, 7) = Empty
            Cells(r + 2, 2) = Empty
            Cells(r + 2, 8) = Empty
          Next k
          r = -7
        End If
        N = N + 1
        If N Mod 2 = 1 Then
          r = r + 14:          c = 1
        Else
          c = 7
        End If
        .Cells(r, c) = "P/O No : " & Lot
        .Cells(r + 2, c + 1) = j
        If N = 10 Then
          N = 0: r = -7
          .PrintPreview
          '.PrintOut
        End If
      Next j
    Next i
    If N > 0 Then
      .PrintPreview
      '.PrintOut
    End If
  End With
End Sub

 

[BuiQuangThuan]

Thử code

Sub InNhan()
  Dim sArr(), S, tmp$
  Dim sRow&, r&, c&, i&, j&, k&, fR&, eR&, N&, Lot$

  With Sheets("NGUON")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A2:B" & i).Value
  End With
  sRow = UBound(sArr)
  N = 0: r = -7
  With Sheets("FORM")
    For i = 1 To sRow
      Lot = sArr(i, 1)
      tmp = Replace(sArr(i, 2), " ", "")
      If InStr(1, tmp, "-") = 0 Then tmp = tmp & "-" & tmp
      S = Split(tmp, "-")
      fR = CLng(S(0))
      eR = CLng(S(1))
      For j = fR To eR
        If N = 0 Then
          For k = 1 To 5
            r = r + 14
            Cells(r, 1).Resize(, 7) = Empty
            Cells(r + 2, 2) = Empty
            Cells(r + 2, 8) = Empty
          Next k
          r = -7
        End If
        N = N + 1
        If N Mod 2 = 1 Then
          r = r + 14:          c = 1
        Else
          c = 7
        End If
        .Cells(r, c) = "P/O No : " & Lot
        .Cells(r + 2, c + 1) = j
        If N = 10 Then
          N = 0: r = -7
          .PrintPreview
          '.PrintOut
        End If
      Next j
    Next i
    If N > 0 Then
      .PrintPreview
      '.PrintOut
    End If
  End With
End Sub

Cảm ơn thầy rất nhiều. Bây giờ em về nhà mất rồi có gì mai em test sẽ phản hồi lại thầy sau ạ

 

[BuiQuangThuan]

Thử code

Chào thầy ạ. Hôm nay em có test. Thấy được rồi thầy ạ
Với lại. Phiền thầy có thể ghi chú giúp em vào đoạn code được không? để em có thể đọc, hiểu cách vận hành của nó với ạ
Cám ơn thầy nhiều

 

[HieuCD]

Chào thầy ạ. Hôm nay em có test. Thấy được rồi thầy ạ
Với lại. Phiền thầy có thể ghi chú giúp em vào đoạn code được không? để em có thể đọc, hiểu cách vận hành của nó với ạ
Cám ơn thầy nhiều

Xem code

Sub InNhan()
  Dim sArr(), S, tmp$
  Dim sRow&, r&, c&, i&, j&, k&, fR&, eR&, N&, Lot$
  Dim fIn&, dIn&
  With Sheets("NGUON")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A2:B" & i).Value 'Mang du lieu
  End With
  sRow = UBound(sArr)
  N = 0 'Thu tu nhan In
  fIn = 7 'Dong in "Lot" dau tien
  dIn = 14 'Koang cach dong 2 nhan in
  r = fIn - dIn 'thu tu dong "Lot", gia tri ban dau r = -7
  With Sheets("FORM")
    For i = 1 To sRow
      Lot = sArr(i, 1) 'Gia tri "Lot"
      tmp = Replace(sArr(i, 2), " ", "")
      If InStr(1, tmp, "-") = 0 Then tmp = tmp & "-" & tmp
      S = Split(tmp, "-")
      fR = CLng(S(0)) 'Thu tu dau
      eR = CLng(S(1)) 'Thu tu cuoi
      For j = fR To eR
        If N = 0 Then 'Xoa du lieu in
          For k = 1 To 5 '5 nhan theo dong
            r = r + dIn 'Dong "Lot"
            Cells(r, 1).Resize(, 7) = Empty 'Xoa dong "Lot"
            Cells(r + 2, 2) = Empty 'Xoa C/No cot B
            Cells(r + 2, 8) = Empty 'Xoa C/No cot H
          Next k
          r = fIn - dIn 'Gia tri ban dau (-7)
        End If
        N = N + 1 'Nhan ke tiep
        If N Mod 2 = 1 Then 'Nhan thu 1 theo cot
          r = r + dIn 'Dong "Lot"
          c = 1 'Cot "A", cot "Lot"
        Else 'Nhan thu 2 theo cot
          c = 7 'Cot "G", cot "Lot"
        End If
        .Cells(r, c) = "P/O No : " & Lot 'ket qua "Lot"
        .Cells(r + 2, c + 1) = j 'ket qua C/No
        If N = 10 Then
          N = 0: r = fIn - dIn 'tra ve gia tri ban dau
          .PrintPreview
          '.PrintOut
        End If
      Next j
    Next i
    If N > 0 Then
      .PrintPreview
      '.PrintOut
    End If
  End With
End Sub