Xin các thầy giúp đỡ code lọc ra đầy đủ dữ liệu (1 người xem)

[Nguyễn Hồng Quang]

Em có làm 1 bảng như file gửi kèm
Mong các thầy giúp đỡ để lọc ra được kết quả đầy đủ
Em xin mô tả sơ lược file để tiện theo dõi
File có 3 sheet (trong đó có 2 sheet đang được sử dụng là -Chi tiet và In BK).
Sheet Chi tiet là nơi chứa dữ liệu, Sheet In BK là sheet dùng code để lấy dữ liệu từ Chi tiet sang (In Bk được định dạng để phục vụ cho việc In ấn)
Khi mở file các thầy Goto giúp tới $S$7 để xem (vì trước khi tắt file em đang đứng ở ô cuối của bảng)

 

[befaint]

(1) Nếu chỉ cần in từng phiếu thì dùng công thức sau (ở sheet "In BK"):

L17=IFERROR(INDEX(OFFSET('Chi tiet'!$L$1,MATCH($S$7,'Chi tiet'!$D$1:$D$200,0)-1,,COUNTIF('Chi tiet'!$D$16:$D$200,$S$7),7),ROW($A1),COLUMN((A$1))),"")

Chèn thêm vài chục dòng (ước lượng phù hợp với số lượng của hóa đơn)
Copy cho các ô còn lại (từ cột L tới cột R luôn)
Khi in thì lọc những giá trị <>"" ở cột N (N16 trở xuống)

(2) Sheet "Chi tiet":
Đánh STT thì chỉ cần công thức sau:

A22=1+MAX($A$15:A21)

rồi copy cho các ô khác
Chứ dùng công thức mảng $E$25:$E$9493="Tổng cộng" đó nặng quá.

 

[HieuCD]

Em có làm 1 bảng như file gửi kèm
Mong các thầy giúp đỡ để lọc ra được kết quả đầy đủ
Em xin mô tả sơ lược file để tiện theo dõi
File có 3 sheet (trong đó có 2 sheet đang được sử dụng là -Chi tiet và In BK).
Sheet Chi tiet là nơi chứa dữ liệu, Sheet In BK là sheet dùng code để lấy dữ liệu từ Chi tiet sang (In Bk được định dạng để phục vụ cho việc In ấn)
Khi mở file các thầy Goto giúp tới $S$7 để xem (vì trước khi tắt file em đang đứng ở ô cuối của bảng)

dùng thử code

Option Explicit
Sub loc1()
  Dim Arr(1 To 100, 1 To 7), Rng As Range, k As Byte, R As Long, Dk As String, j As Byte
  Range("A17:U9999").Clear
  Dk = [s7]
  With Sheets("Chi tiet")
    R = .Range("D65500").End(xlUp).Row
    Set Rng = .Range("D15:D" & R).Find(Dk, .Range("D15"), LookIn:=xlValues, lookat:=xlWhole)
    If Not Rng Is Nothing Then
      R = Rng.Row
      Do
        k = k + 1
        Arr(k, 1) = k
        For j = 2 To 7
          Arr(k, j) = .Cells(R, j + 11)
        Next j
        R = R + 1
      Loop Until .Cells(R + 1, 4) <> Dk
      Arr(k + 1, 2) = .Cells(R, 5)
      Arr(k + 1, 7) = .Cells(R, 18)
    Else
      MsgBox ("Không có du lieu")
      Exit Sub
    End If
  End With
  Range("L17").Resize(R, 7) = Arr
  R = Range("L9999").End(3).Row
  Range("L17:R" & R + 1).Borders.LineStyle = xlContinuous
  Range("L" & R + 3) = Sheets("Chi tiet").Cells(15, 23)
  Range("N" & R + 3) = Sheets("Chi tiet").Cells(15, 24)
  Range("Q" & R + 3) = Sheets("Chi tiet").Cells(15, 25)
End Sub

 

[befaint]

Anh HieuCD,

Sau khi range.clear (Range("A17:U9999").Clear) thì font chữ, format cells trong range sẽ trở về mặc định
nên cần thêm dòng lệnh thiết lập lại font, format cells (Cần vì sử dụng để in).

 

[Nguyễn Hồng Quang]

dùng thử code

Option Explicit
Sub loc1()
  Dim Arr(1 To 100, 1 To 7), Rng As Range, k As Byte, R As Long, Dk As String, j As Byte
  Range("A17:U9999").Clear
  Dk = [s7]
  With Sheets("Chi tiet")
    R = .Range("D65500").End(xlUp).Row
    Set Rng = .Range("D15:D" & R).Find(Dk, .Range("D15"), LookIn:=xlValues, lookat:=xlWhole)
    If Not Rng Is Nothing Then
      R = Rng.Row
      Do
        k = k + 1
        Arr(k, 1) = k
        For j = 2 To 7
          Arr(k, j) = .Cells(R, j + 11)
        Next j
        R = R + 1
      Loop Until .Cells(R + 1, 4) <> Dk
      Arr(k + 1, 2) = .Cells(R, 5)
      Arr(k + 1, 7) = .Cells(R, 18)
    Else
      MsgBox ("Không có du lieu")
      Exit Sub
    End If
  End With
  Range("L17").Resize(R, 7) = Arr
  R = Range("L9999").End(3).Row
  Range("L17:R" & R + 1).Borders.LineStyle = xlContinuous
  Range("L" & R + 3) = Sheets("Chi tiet").Cells(15, 23)
  Range("N" & R + 3) = Sheets("Chi tiet").Cells(15, 24)
  Range("Q" & R + 3) = Sheets("Chi tiet").Cells(15, 25)
End Sub

Thưa thầy , sau khi chạy code thì em có thể định dạng lại các cột còn lại. nhưng mà cái cột Mã hàng hóa thì nó mất nhiều công sức để lấy đúng định dạng ban đầu của nó quá. Mong thầy giúp em sao cho sau khi trích xuất dữ liệu thì định dạng của cột Mã hàng hóa nó giữ được định dạng 999999999999.
Xin cảm ơn thầy rất nhiều. Mong được hậu tạ thầy

 

[HieuCD]

Anh HieuCD,

Sau khi range.clear (Range("A17:U9999").Clear) thì font chữ, format cells trong range sẽ trở về mặc định
nên cần thêm dòng lệnh thiết lập lại font, format cells (Cần vì sử dụng để in).

chỉ dùng lại các lệnh có sẵn trong file, cũng không biết nhu cầu trình bày như thế nào
format lại cell hơi ngại, thông thường mình clear chừa lại 1 dòng, sao đó copy định dạng cho gọn
chúc bạn một tối vui

 

[HieuCD]

Thưa thầy , sau khi chạy code thì em có thể định dạng lại các cột còn lại. nhưng mà cái cột Mã hàng hóa thì nó mất nhiều công sức để lấy đúng định dạng ban đầu của nó quá. Mong thầy giúp em sao cho sau khi trích xuất dữ liệu thì định dạng của cột Mã hàng hóa nó giữ được định dạng 999999999999.
Xin cảm ơn thầy rất nhiều. Mong được hậu tạ thầy

bạn sửa lại code

....  
End With
[COLOR=#ff0000]  Range("L17").Resize(k + 1, 7) = Arr[/COLOR]
[COLOR=#ff0000]  Range("M17").Resize(k).NumberFormat = "############ "[/COLOR]
[COLOR=#ff0000]  Range("P17").Resize(k + 1, 3).NumberFormat = "#,### "[/COLOR]
  R = Range("L9999").End(3).Row
  Range("L17:R" & R + 1).Borders.LineStyle = xlContinuous
  Range("L" & R + 3) = Sheets("Chi tiet").Cells(15, 23)
  Range("N" & R + 3) = Sheets("Chi tiet").Cells(15, 24)
  Range("Q" & R + 3) = Sheets("Chi tiet").Cells(15, 25)
End Sub[code]

 

[Nguyễn Hồng Quang]

Em cảm ơn thầy.
EM rất mong được học hỏi nhiều hơn từ thầy

 

[Nguyễn Hồng Quang]

Bang ke chi tiet in kem hoa don (form)

(1) Nếu chỉ cần in từng phiếu thì dùng công thức sau (ở sheet "In BK"):

L17=IFERROR(INDEX(OFFSET('Chi tiet'!$L$1,MATCH($S$7,'Chi tiet'!$D$1:$D$200,0)-1,,COUNTIF('Chi tiet'!$D$16:$D$200,$S$7),7),ROW($A1),COLUMN((A$1))),"")

Chèn thêm vài chục dòng (ước lượng phù hợp với số lượng của hóa đơn)
Copy cho các ô còn lại (từ cột L tới cột R luôn)
Khi in thì lọc những giá trị <>"" ở cột N (N16 trở xuống)
.

Rất cảm ơn góp ý thần sầu, (đặc biệt là ở câu gợi ý này của thầy)

Chèn thêm vài chục dòng (ước lượng phù hợp với số lượng của hóa đơn)
Copy cho các ô còn lại (từ cột L tới cột R luôn)
.

Vì nhờ có mấy câu này của thầy, nó đã giúp em mở ra 1 cách nhìn khác vừa giúp cho việc nhặt đủ dữ liệu vừa kết hợp luôn copy định dạng các dòng tiếp theo dòng L17 (của thầy)
Dưới đây là code và file em đã hoàn thiện theo hướng đi của thầy (1 lần nữa xin cảm ơn thầy)

Sub Button28_Click()  
  Range("A18:U9999").Clear
    Range("K17").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF('Chi tiet'!R16C4:R9999C4,'In BK'!R7C19)"
lr = [K16].End(xlDown).Row
    For i = lr To 2 Step -1
        If Cells(i, 11) > 1 Then
           Cells(i + 1, 11).Select
           R = Cells(i, 11)
            Selection.Resize(Cells(i, 11) - 1, 1).Select
            Selection.EntireRow.Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i, 11).Select
            Selection.Value = 1
            Selection.Resize(R, 1).Select
            Selection.EntireRow.Select
            Selection.FillDown
        End If
 lr = [K16].End(xlDown).Row
    Next
    For rw = Cells(65536, 14).End(xlDown).Row To 1 Step -1
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw, 14).Font.FontStyle = "Bold"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw, 14).Font.Size = "10"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw, 18).Font.FontStyle = "Bold"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw, 18).Font.Size = "10"
Next rw
 For rw = Cells(65536, 14).End(xlDown).Row To 1 Step -1
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw - 1, 14).Font.FontStyle = "Bold"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw - 1, 14).Font.Size = "10"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw - 1, 18).Font.FontStyle = "Bold"
       If Cells(rw, 14).Value = Cells(1, 19).Value Then Cells(rw - 1, 18).Font.Size = "10"
Next rw
Dim LastRow As Long
    With ActiveSheet
    LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
Cells(LastRow + 2, "L").Select
Cells(LastRow + 1, "L") = "     " & Sheets("Chi tiet").Cells(15, 26) & Cells(6, 31)
Cells(LastRow + 1, "L").Font.Name = "Times New Roman"
Cells(LastRow + 1, "L").Font.FontStyle = "Italic"
Cells(LastRow + 2, "L") = "     " & Sheets("Chi tiet").Cells(15, 23)
Cells(LastRow + 2, "L").Font.Name = "Times New Roman"
Cells(LastRow + 2, "L").Font.FontStyle = "Bold"
Cells(LastRow + 2, "N") = "                            " & Sheets("Chi tiet").Cells(15, 24)
Cells(LastRow + 2, "N").Font.Name = "Times New Roman"
Cells(LastRow + 2, "N").Font.FontStyle = "Bold"
Cells(LastRow + 2, "Q") = "     " & Sheets("Chi tiet").Cells(15, 25)
Cells(LastRow + 2, "Q").Font.Name = "Times New Roman"
Cells(LastRow + 2, "Q").Font.FontStyle = "Bold"
Cells(LastRow + 3, "L") = "     " & Sheets("Chi tiet").Cells(15, 27)
Cells(LastRow + 3, "L").Font.Name = "Times New Roman"
Cells(LastRow + 3, "L").Font.FontStyle = "Italic"
Cells(LastRow + 3, "N") = "                            " & Sheets("Chi tiet").Cells(15, 27)
Cells(LastRow + 3, "N").Font.Name = "Times New Roman"
Cells(LastRow + 3, "N").Font.FontStyle = "Italic"
Cells(LastRow + 3, "Q") = "     " & Sheets("Chi tiet").Cells(15, 28)
Cells(LastRow + 3, "Q").Font.Name = "Times New Roman"
Cells(LastRow + 3, "Q").Font.FontStyle = "Italic"


End With
End Sub

Mong nhận được thêm góp ý của các thầy từ cách làm này
(Tiện thể cho em hỏi Trong GPE dung lượng tải file của em sắp hết có cách nào Làm mới lại dung lượng này ko ạ!!!!)