Làm sao để Label hiển thị dữ liệu động theo Sheet Data ! (4 người xem)

[vungoc]

Nhờ các bạn giúp tôi thực hiện vấn đề sau:

1- Mô tả:

- Tại Sheet Data có bảng dữ liệu DANH MỤC PHỤ TÙNG (Số lượng dữ liệu chỉ nằm trong 10 dòng (Row)).
+ Dữ liệu trong các cột (Colomns): MÃ PHỤ TÙNG, TÊN PHỤ TÙNG, THÔNG SỐ KỸ THUẬT, SỐ LƯỢNG là thay đổi - Do người ta nhập vào (Dùng bảng này để nhập dữ liệu nhiều lần).
+ Bên Sheet Label là các bảng nhãn hiển thị theo dữ liệu của bảng DANH MỤC PHỤ TÙNG (Nếu bảng DANH MỤC PHỤ TÙNG thay đổi thì bên Sheet Label số lượng các nhãn Label cũng thay đổi theo.

2- Vấn đề cần giải quyết:
- Khi số liệu trong bảng DANH MỤC PHỤ TÙNG thay đổi thì các nhãn bên Sheet Label cũng thay đổi theo (Cả về nội dung cũng như số lượng các nhãn):
+ Ví dụ: Trong bảng DANH MỤC PHỤ TÙNG hiện tại:
. Dòng thứ 1 có số lượng = 1. Thì bên Sheet Label cũng hiển thị 1 nhãn.
. Dòng thứ 2 có số lượng = 2. Thì bên Sheet Label cũng hiển thị 2 nhãn (Có cùng nội dung).
. Dòng thứ 2 có số lượng = 3. Thì bên Sheet Label cũng hiển thị 5 nhãn (Có cùng nội dung).
... cứ như thế ...
... Như vậy là bên Sheet Label tổng cộng phải hiển thị đủ 29 nhãn.

Mục đích: để mỗi lần nhập phụ tùng thì sẽ in ra đủ số nhãn (label) để dán lên phụ tùng rồi nhập vào kho.
lưu ý: Bên sheet Label chỉ hiển thị đúng số lượng nhãn theo mỗi lần nhập bên sheet Data.

* Các anh chị vui lòng giúp mình thực hiện vấn đề này với nhé (Có thể dùng hàm hoặc VBA tùy ý).

Các anh chị vui lòng xem hộ file đính kèm.

Mong sớm nhận được sự trợ giúp / Trân trọng cảm ơn !

 

[ThuNghi]

Cái này bạn chịu khó kiếm chương trình in tem (mã vạch nhưng bỏ mã vạch) cách đây 10 năm tên là label design, cho phép in theo sl từng lọai hàng và theo từng lọai giấy, có cho phép thiết kế logo trên ấy và quan trọng là có thể lấy DL từ các phần mềm: Excel, TXT.. Rất hay. Ra ngòai BTX hay hỏi Bác Hiếu.
Còn làm Excel thì tôi sẽ làm cho, tính vài ba chai là OK.

 

[vungoc]

Đây chỉ là một phần em trích ra để ví dụ file QUẢN LÝ PHỤ TÙNG của em bác ạ !
Mục đích: để mỗi lần nhập phụ tùng thì sẽ in ra đủ số nhãn (label) để dán lên phụ tùng rồi nhập vào kho.
Bác giúp dùm em trong excel nhé (lưu ý: Bên sheet Label chỉ hiển thị đúng số lượng nhãn theo mỗi lần nhập bên sheet Data thôi bác nhé).
Bữa nào gặp lại bác - không say không về - hà hà hà !

 

[Mr Okebab]

Cái này bạn chịu khó kiếm chương trình in tem (mã vạch nhưng bỏ mã vạch) cách đây 10 năm tên là label design, cho phép in theo sl từng lọai hàng và theo từng lọai giấy, có cho phép thiết kế logo trên ấy và quan trọng là có thể lấy DL từ các phần mềm: Excel, TXT.. Rất hay. Ra ngòai BTX hay hỏi Bác Hiếu.
Còn làm Excel thì tôi sẽ làm cho, tính vài ba chai là OK.

Ông VUNGOC lười quá luôn. Phần mềm về Label thì đầy, tuy nhiên bác VuNgoc không thích đâu (vì bác muốn tích hợp vào trong File của bác luôn)

công thức thì Bác ThuNghi làm xong rồi, chỉ chờ "chai" là send ngay
Vậy thì bàn về VBA nhé.
Trước hết bàn về ý tưởng :

Ở đây mục tiêu cả bác là in cái nhãn đó theo đúng số lần của nó và trên cùng 1 trang. Vì vậy có 2 cách (theo em) :

1. Tạo ra các mẫu nhãn sẵn : VD 50 mẫu trên 1 trang A4. Và xét số lần xuất hiện, căn cứ vào đó để điền thông tin vào các mẫu (số mẫu = số lần xuất hiện), số còn lại sẽ ẩn đi (cho trắng đi)
2. Chỉ tạo 1 mẫu thôi, sau đó điền thông tin vào mẫu này. Xét xem mẫu này lặp bao nhiêu lần, và cứ thế Copy nguyên cả mẫu xuống dưới cho đúng bằng số lần xuất hiện.

Đây là ý tưởng, cứ thống nhất đã. Còn làm VBA để thể hiện ý tưởng chỉ là . . . chuyện nhỏ
Bác chọn cái nào ?? (đừng nói cả hai, tội nghiệp em)
Thân!

 

[anhphuong]

Tốt nhất là làm theo cách thứ nhất tiện lợi hơn Bắp ah

 

[vungoc]

Ông VUNGOC lười quá luôn. Phần mềm về Label thì đầy, tuy nhiên bác VuNgoc không thích đâu (vì bác muốn tích hợp vào trong File của bác luôn) - Đúng là như thế, với lại chẳng phải là lười đâu, chỉ tại cái đầu của mình nó hơi bị củ chuối - nên nghĩ không ra được !

công thức thì Bác ThuNghi làm xong rồi, chỉ chờ "chai" là send ngay
Vậy thì bàn về VBA nhé.
Trước hết bàn về ý tưởng :

Ở đây mục tiêu của bác là in cái nhãn đó theo đúng số lần của nó và trên cùng 1 trang (nếu số nhãn nhiều hơn 1 trang thì 2, 3, ... trang trở lên cũng chả sao - miễn là vừa đủ số lượng các nhãn theo như data). Vì vậy có 2 cách (theo em) :

1. Tạo ra các mẫu nhãn sẵn : VD 50 mẫu trên 1 trang A4. Và xét số lần xuất hiện, căn cứ vào đó để điền thông tin vào các mẫu (số mẫu = số lần xuất hiện), số còn lại sẽ ẩn đi (cho trắng đi) - ý mình cũng muốn vậy, để khỏi tốn giấy, mực những khi số nhãn ít
2. Chỉ tạo 1 mẫu thôi, sau đó điền thông tin vào mẫu này. Xét xem mẫu này lặp bao nhiêu lần, và cứ thế Copy nguyên cả mẫu xuống dưới cho đúng bằng số lần xuất hiện.

Đây là ý tưởng, cứ thống nhất đã. Còn làm VBA để thể hiện ý tưởng chỉ là . . . chuyện nhỏ - Đúng là rất OKebab
Bác chọn cái nào ?? (đừng nói cả hai, tội nghiệp em)
Thân!

Nếu không cho nói cả 2 thì nên chọn cách thứ nhất là OK thôi - ha ha !
Cảm ơn Mr. Hiếu nhé !

 

[SoiBien]

Bác Vungoc xem thử nhé

Label bác đì zai lại thoải mái (nhưng 2 cột thôi)
Có gì cứ post lên nhé
Thân.

 

[ThuNghi]

Cái này ké SoiBien, anh em hợp đồng bắt Ngọc mời nhậu, mình có công sửa lại chút xíu, phần STT chưa ổn.

Option Explicit
Sub FormatLabel()
'
' FormatLabel Macro
' Macro recorded 02/10/2007 by QuocAnh
'
Dim LabelRow As Integer
Dim TotalLabel As Integer
Dim i As Integer, j As Integer

Dim NextRow As Integer
Dim NextLabel As Integer
Dim DataRng As Range
LabelRow = Range("Labeltemplate").Rows.Count
TotalLabel = Range("TotalLabel").Value
'TotalLableType =
On Error GoTo errHandler
Set DataRng = Range("DMPT")
'De dom cho dep
Application.ScreenUpdating = False
ClearOldLabel
NextRow = 1
NextLabel = 1
Do While NextRow <= 10
   If DataRng.Cells(NextRow + 1, 5) > 0 Then
      For i = 1 To DataRng.Cells(NextRow + 1, 5)
      'Format
          Cells(2 + Int((NextLabel - 1) / 2) * (LabelRow + 1), IIf((NextLabel Mod 2) = 1, 1, 4)).Select
          LabelTemplate (ActiveCell.Address)
          NextLabel = NextLabel + 1
         'Debug.Print NextLabel
       'Gan du lieu
          ActiveCell.Offset(0, 1).Value = DataRng.Cells(NextRow + 1, 1) 'i
          ActiveCell.Offset(1, 1).Value = DataRng.Cells(NextRow + 1, 2)
          ActiveCell.Offset(2, 1).Value = DataRng.Cells(NextRow + 1, 3)
          ActiveCell.Offset(3, 1).Value = DataRng.Cells(NextRow + 1, 4)
      Next i
   End If
    NextRow = NextRow + 1
Loop
    MsgBox "Cac nhan da duoc tao ra!"
    Exit Sub
errHandler:
    MsgBox "Co loi, de nghi xem lai du lieu!"
    Application.ScreenUpdating = True
End Sub
Sub LabelTemplate(Cell As String)
    'Copy template from range LabelTemplate
    Application.Goto Reference:="LabelTemplate"
    Selection.Copy
    Sheets("Label").Activate
    Range(Cell).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

Sub ClearOldLabel()
' Moi vo thi phai clear het cho dep
    Sheets("Label").Activate
    Cells.ClearContents
    Cells.ClearFormats
End Sub

Vậy phải mời 2 người, khỏi làm = c/thức nhé, làm công thức thì dùng if và max, nếu cần thì làm, thêm dĩa mồi.

 

[SoiBien]

Cái này ké SoiBien, anh em hợp đồng bắt Ngọc mời nhậu, mình có công sửa lại chút xíu, phần STT chưa ổn.

ActiveCell.Offset(0, 1).Value = DataRng.Cells(NextRow + 1, 1) 'i

Vậy phải mời 2 người, khỏi làm = c/thức nhé, làm công thức thì dùng if và max, nếu cần thì làm, thêm dĩa mồi.

ặc ặc, anh ơi, STT thì đánh theo từng Phụ tùng, không phải chạy theo toàn bộ, dạ, anh coi lại vD của bác vungoc.

HIHI, được nhậu hả ta? có nghe nói đâu?

 

[vungoc]

Sửa số TT lại như anh ThuNghi là đúng ý em rồi đấy.
Cảm ơn các bác nhiều lắm !
Mai nhậu thôi, các bác ơi !

(Lâu rồi không gặp nhớ các bác quá)

 

[ThuNghi]

Mà Vũ Ngọc thấy OK? STT đánh theo gì?
Mai khỏang 18h00 nhé, ông SeaFox kia invisible có nghe không, địa điểm DT sau, tiền trạm cho offline VEC.

 

[Mr Okebab]

Code của các bác dài thế ??? Không ngắn hơn được phải không các bác.
Em đọc mướt cả mồ hôi!
Theo em nghĩ là có thể ngắn lại đấy.

Thân!

 

[vungoc]

Mà Vũ Ngọc thấy OK? STT đánh theo gì?
Mai khỏang 18h00 nhé, ông SeaFox kia invisible có nghe không, địa điểm DT sau, tiền trạm cho offline VEC.

Sửa số TT lại như anh ThuNghi là đúng ý em rồi đấy.
To: Mr. Hiếu: Nếu được bác edit cái code cho nó ngắn ngủn lại thì càng tốt.

Cảm ơn các bác nhiều lắm !
Mai nhậu thôi, các bác ơi !

(Lâu rồi không gặp nhớ các bác quá)

Thân ái !

 

[levanduyet]

Đề nghị một tí

Xin được góp ý một tí (muốn tham gia lắm lắm !!!)

Option Explicit
Sub FormatLabel()
'
' FormatLabel Macro
' Macro recorded 02/10/2007 by QuocAnh
'
Dim LabelRow As Integer
Dim TotalLabel As Integer
Dim i As Integer, j As Integer

Dim NextRow As Integer
Dim NextLabel As Integer
Dim DataRng As Range
LabelRow = Range("Labeltemplate").Rows.Count
TotalLabel = Range("TotalLabel").Value 'Có thể không cần Value vì đây là thuộc tính mặc định
'TotalLableType =
On Error GoTo errHandler
Set DataRng = Range("DMPT")
'De dom cho dep
Application.ScreenUpdating = False
ClearOldLabel
NextRow = 1
NextLabel = 1
Do While NextRow <= 10
   If DataRng.Cells(NextRow + 1, 5) > 0 Then
      For i = 1 To DataRng.Cells(NextRow + 1, 5)
      'Format
          Cells(2 + Int((NextLabel - 1) / 2) * (LabelRow + 1), IIf((NextLabel Mod 2) = 1, 1, 4)).Select '[B][I]Không cần dùng Select làm như vậy chương trình sẽ chậm hơn[/I][/B]
          LabelTemplate (ActiveCell.Address)
          NextLabel = NextLabel + 1
         'Debug.Print NextLabel
       'Gan du lieu
          ActiveCell.Offset(0, 1).Value = DataRng.Cells(NextRow + 1, 1) 'i
          ActiveCell.Offset(1, 1).Value = DataRng.Cells(NextRow + 1, 2)
          ActiveCell.Offset(2, 1).Value = DataRng.Cells(NextRow + 1, 3)
          ActiveCell.Offset(3, 1).Value = DataRng.Cells(NextRow + 1, 4)
      Next i
   End If
    NextRow = NextRow + 1
Loop

    MsgBox "Cac nhan da duoc tao ra!"
    Exit Sub
errHandler:
    MsgBox "Co loi, de nghi xem lai du lieu!"
    Application.ScreenUpdating = True
End Sub

Trong phần bẫy lỗi anh chú ý: ví dụ như lỗi có xãy ra thì mới có thể:

Application.ScreenUpdating = True

Vậy phải sửa lại đoạn code trên

Sub LabelTemplate(Cell As String)
    'Copy template from range LabelTemplate
    Application.Goto Reference:="LabelTemplate"
    Selection.Copy
    Sheets("Label").Activate
    Range(Cell).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

Đoạn code trên có thể sửa lại như sau:

Sub LabelTemplate(Cell As String)
Dim rng1 As Range, rng2 As Range
    'Mục đích giảm thiểu phương thức Select chương trình sẽ nhanh hơn
    Set rng1=Application.Thisworkbook.Range"LabelTemplate"
    Set rng2=Application.Thisworkbook.Range(Cell) 'Ở đây nên kiểm tra biến Cell trước
    rng1.Copy rng2
    Set rng1=nothing: Set rng2=nothing
End Sub

Chúng ta cũng có thể sửa tương tự cho thủ tục khác

Sub ClearOldLabel()
Dim rng As Range
' Mục đích cũng giống như ở trên
Set rng=Application.ThisWorkbook.Worksheets("Lable").Cells
rng.Clear
Set rng=nothing 'Giải phóng bộ nhớ
End Sub

LVD

 

[SoiBien]

Xin được góp ý một tí (muốn tham gia lắm lắm !!!)

LVD

Cám ơn anh đã sửa code hộ, thực sự phần Optimize này em còn kém lắm, chả có làm cái gì lớn bao giờ anh ạ.
Trích :
ThuNghiMà Vũ Ngọc thấy OK? STT đánh theo gì?
Mai khỏang 18h00 nhé, ông SeaFox kia invisible có nghe không, địa điểm DT sau, tiền trạm cho offline VEC.

em Off thiệt đó ạ, bò từ BD về đó!
còn cái nick thì trước giờ em cứ dịch là SeaWolf

Trích:
vungocSửa số TT lại như anh ThuNghi là đúng ý em rồi đấy.

Nhất trí cao!!! (Theo ý khổ chủ

 

[Mr Okebab]

Xin được góp ý một tí (muốn tham gia lắm lắm !!!)

Sub LabelTemplate(Cell As String)
    'Copy template from range LabelTemplate
    Application.Goto Reference:="LabelTemplate"
    Selection.Copy
    Sheets("Label").Activate
    Range(Cell).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

Đoạn code trên có thể sửa lại như sau:

Sub LabelTemplate(Cell As String)
Dim rng1 As Range, rng2 As Range
    'Mục đích giảm thiểu phương thức Select chương trình sẽ nhanh hơn
    Set rng1="LabelTemplate"
    Set rng2=Range(Cell)
    rng1.Copy rng2
    Set rng1=nothing: Set rng2=nothing
End Sub

Chúng ta cũng có thể sửa tương tự cho thủ tục khác

Sub ClearOldLabel()
Dim rng As Range
' Mục đích cũng giống như ở trên
Set rng=Application.ThisWorkbook.Worksheets.Cells
rng.Clear
Set rng=nothing 'Giải phóng bộ nhớ
End Sub

LVD

Theo em cũng không cần phải làm thế đâu :

 Sub LabelTemplate(Cell As String)
    Sheet3.Range("B2:C5").Copy Sheet2.Range(ActiveCell, ActiveCell.Offset(3, 1))
End Sub

Sub ClearOldLabel()
    Sheet2.Range("A1:A1000").EntireRow.Delete
End Sub

.....................

Hoặc bỏ luôn 2 Sub này, chỉ còn lại 1 sub (chưa tối giản)

Option Explicit
Sub FormatLabel()
    On Error GoTo errHandler
    Application.ScreenUpdating = False
    Dim LabelRow, TotalLabel, i, Nextrow, NextLabel As Integer
    Dim Datarng As Range
    
    LabelRow = Range("Labeltemplate").Rows.Count
    TotalLabel = Range("TotalLabel").Value
    Set Datarng = Range("DMPT")
    Sheet2.Select
    Sheet2.Range("A1:A1000").EntireRow.Delete
    Nextrow = 1
    NextLabel = 1
    Do While Nextrow <= 10
        If Datarng.Cells(Nextrow + 1, 5) > 0 Then
            For i = 1 To Datarng.Cells(Nextrow + 1, 5)
                Cells(2 + Int((NextLabel - 1) / 2) * (LabelRow + 1), IIf((NextLabel Mod 2) = 1, 1, 4)).Select
                Sheet3.Range("B2:C5").Copy Sheet2.Range(ActiveCell, ActiveCell.Offset(3, 1))
                NextLabel = NextLabel + 1
                ActiveCell.Offset(0, 1).Value = i
                ActiveCell.Offset(1, 1).Value = Datarng.Cells(Nextrow + 1, 2)
                ActiveCell.Offset(2, 1).Value = Datarng.Cells(Nextrow + 1, 3)
                ActiveCell.Offset(3, 1).Value = Datarng.Cells(Nextrow + 1, 4)
            Next i
        End If
        Nextrow = Nextrow + 1
    Loop

errHandler:
    Application.ScreenUpdating = True
End Sub

Thân!
(Mai em sẽ post File tối giản lên)

 

[levanduyet]

To: Okebab,

Vậy xin đố em (chỉ để học hỏi thôi ) theo đoạn code của em (theo như cách em sửa) thì khi nào sẽ xảy ra lỗi ?

Lê Văn Duyệt

 

[SoiBien]

Trong khi chờ đợi file tối giản thì bác Vungoc xài cái đã được sửa lại theo ý các Bác ở trên nhé.

 

[Mr Okebab]

To: Okebab,

Vậy xin đố em (chỉ để học hỏi thôi ) theo đoạn code của em (theo như cách em sửa) thì khi nào sẽ xảy ra lỗi ?

Lê Văn Duyệt

Đây là File đã được tối giản (1 sub duy nhất) :

Option Explicit
Sub FormatLabel()
    On Error GoTo thoat
    Application.ScreenUpdating = False
    Dim HC, SL, i, STT As Integer
    Dim Ma As Range
    HC = Sheet1.Range("B65000").End(xlUp).Row
    STT = 0
    If HC < 3 Then GoTo thoat
    Sheet2.Select
    Sheet2.Range("A1:A1000").EntireRow.Delete
    
    For Each Ma In Sheet1.Range("B3:B" & HC)
        If Ma.Offset(0, 3) > 0 Then
            For i = 1 To Ma.Offset(0, 3)
                STT = STT + 1
                Sheet3.Range("B1") = STT
                Sheet3.Range("B2") = Ma
                Sheet3.Range("B3") = Ma.Offset(0, 1)
                Sheet3.Range("B4") = Ma.Offset(0, 2)
                Sheet3.Range("A1:B4").Copy Sheet2.Range(Cells(2 + (Round((STT + 0.5) / 2, 0) - 1) * 5, IIf((STT Mod 2) = 1, 1, 4)), Cells(5 + (Round((STT + 0.5) / 2, 0) - 1) * 5, IIf((STT Mod 2) = 1, 2, 5)))
            Next
        End If
    Next
    Set Ma = Nothing
thoat:
    Application.ScreenUpdating = True
End Sub

Còn về lỗi như bác Duyệt nói thì em chưa nghiên cứu vì em không dùng Do While, em dùng For each thôi.

Thân!

 

[levanduyet]

To: Okebab,
1.

Dim HC, SL, i, STT As Integer

Nếu khai báo như trên thì chỉ có biến STT là kiểu Integer
Còn các biến HC, SL, i là kiểu Variant
Đối với Visual Basic 6.0 thì cũng gặp trường hợp giống vậy. Nếu dùng Visual Basic .Net thì khai báo như trên thì các biến đều là biến kiểu Integer.
2.

HC = Sheet1.Range("B65000").End(xlUp).Row

Thông thường khi viết một thủ tục, chúng ta sẽ gọi thủ tục đó từ Menu hoặc Shortcut.
Nếu viết như trên thì sẽ bị gặp lỗi một khi bạn gọi thủ tục mà workbook khác đang Active. Đây là lỗi thường gặp khi chúng ta viết các Add-In. Ví dụ như Add-in của bác phamduylong.
Chúng ta nên tập viết code như sau:

HC = Thisworkbook.Worksheets("Sheet1").Range("B65000").End(xlUp).Row

Lê Văn Duyệt