Chèn dòng dựa vào giá trị của cell.

phuteo · 6/9/10

Mình đang gặp phải 1 vấn đề cần nhờ các bác chỉ giáo.Mình có 1 file gồm 2 cột, cột A là cột mã, cột B là số lượng.Câu hỏi là làm cách nào để khi gõ số lượng vào cột B sẽ sinh ra số dòng tương ứng với số lượng gõ vào cột B.

concogia · 6/9/10

phuteo đã viết:
Mình đang gặp phải 1 vấn đề cần nhờ các bác chỉ giáo.Mình có 1 file gồm 2 cột, cột A là cột mã, cột B là số lượng.Câu hỏi là làm cách nào để khi gõ số lượng vào cột B sẽ sinh ra số dòng tương ứng với số lượng gõ vào cột B.

Nếu mình hiểu đúng thì bạn làm thế này
RightClick vào Sheet1 ==> View Code chép "thằng" này vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$2" Then
        Range("A2:A" & [b2] + 1).FillDown
    End If
End Sub

Nhập số lượng ở B2

phuteo · 6/9/10

concogia đã viết:
Nếu mình hiểu đúng thì bạn làm thế này
RightClick vào Sheet1 ==> View Code chép "thằng" này vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$2" Then Range("A2:A" & [b2] + 1).FillDown End If End Sub

Nhập số lượng ở B2

Mình đưa file thực tế lên bạn test dùm nhé, đây là file để mình in tem thông tin sản phẩm nó sẽ thay đổi liên tục (có thể nhiều mã trên 1 file)bạn có code nào để khi thay đổi thông tin mà không cần phải làm lại như trên không vậy

concogia · 7/9/10

phuteo đã viết:
Mình đưa file thực tế lên bạn test dùm nhé, đây là file để mình in tem thông tin sản phẩm nó sẽ thay đổi liên tục (có thể nhiều mã trên 1 file)bạn có code nào để khi thay đổi thông tin mà không cần phải làm lại như trên không vậy

Hiện tại mình chưa biết làm cách nào hay hơn, tạm thời như thế này, trong bảng dữ liệu cứ "thằng" nào ở cột G có dữ liệu thi nó sẽ theo đó mà chèn dòng & dữ liệu vào đồng thời nó sẽ "thịt" tuốt tuồn tuột những em khác, bạn chú ý chỗ này nhé
Hy vọng giúp được bạn tí tẹo
Thân

sealand · 7/9/10

Đã làm với ý đồ tạo tem mác thì sao không làm thành Tem mác thành phẩm nhỉ?
Bạn tham khảo file của mình kèm theo xem sao. Code cũng rất đơn giản và ngắn gọn. Bạn cứ điền đủ thông tin từng loại hàng và số lượng tem là được.
(Mình dùng file mẫu của bạn nhưng không hiểu sao định dạng, Edit, lưu rất chậm)

Mã:

Option Explicit
Sub PrintMark()
  Dim Dg, j, m
   Dim Cl As Range
     Application.ScreenUpdating = False
       Rp.Cells.Clear
         Dg = 2
          For Each Cl In DT.Range("G2", DT.[g65536].End(xlUp))
        If Cl > 0 Then
       For j = 1 To Cl
      Ro.[c2:c7] = WorksheetFunction.Transpose(Range( _
    Cl.Offset(, -6), Cl.Offset(, -1)))
   Dg = IIf(m = 3, Dg + 7, Dg)
  m = IIf(m = 3, 1, m + 1)
 Ro.[B2:C7].Copy Rp.Cells(Dg, m * 3 - 1)
Next: End If: Next
End Sub

phuteo · 7/9/10

sealand đã viết:
Đã làm với ý đồ tạo tem mác thì sao không làm thành Tem mác thành phẩm nhỉ?
Bạn tham khảo file của mình kèm theo xem sao. Code cũng rất đơn giản và ngắn gọn. Bạn cứ điền đủ thông tin từng loại hàng và số lượng tem là được.
(Mình dùng file mẫu của bạn nhưng không hiểu sao định dạng, Edit, lưu rất chậm)

Mã:

Option Explicit Sub PrintMark() Dim Dg, j, m Dim Cl As Range Application.ScreenUpdating = False Rp.Cells.Clear Dg = 2 For Each Cl In DT.Range("G2", DT.[g65536].End(xlUp)) If Cl > 0 Then For j = 1 To Cl Ro.[c2:c7] = WorksheetFunction.Transpose(Range( _ Cl.Offset(, -6), Cl.Offset(, -1))) Dg = IIf(m = 3, Dg + 7, Dg) m = IIf(m = 3, 1, m + 1) Ro.[B2:C7].Copy Rp.Cells(Dg, m * 3 - 1) Next: End If: Next End Sub

Cảm ơn bạn đã giúp nhưng chương trình in tem của mình chỉ load thông tin từ file excel theo mẫu mình đưa lên thôi

sealand · 7/9/10

Nếu vậy thì chỉ cần như thế này thôi, khi nhập xong sang sheet Report là có

Mã:

Sub PrintMark()
   Dim Cl As Range, Cl1 As Range
     Application.ScreenUpdating = False
       Rp.Range("A2", Rp.[f56536].End(xlUp)).Clear
       Set Cl1 = Rp.[A2]
          For Each Cl In DT.Range("G2", DT.[g65536].End(xlUp))
        If Cl > 0 Then
 Cl1.Resize(Cl, 6).Value = Range(Cl.Offset(, -6), Cl.Offset(, -1)).Value
 Set Cl1 = Cl1.Offset(Cl)
End If: Next
End Sub

phuteo · 9/9/10

sealand đã viết:
Nếu vậy thì chỉ cần như thế này thôi, khi nhập xong sang sheet Report là có

Mã:

Sub PrintMark() Dim Cl As Range, Cl1 As Range Application.ScreenUpdating = False Rp.Range("A2", Rp.[f56536].End(xlUp)).Clear Set Cl1 = Rp.[A2] For Each Cl In DT.Range("G2", DT.[g65536].End(xlUp)) If Cl > 0 Then Cl1.Resize(Cl, 6).Value = Range(Cl.Offset(, -6), Cl.Offset(, -1)).Value Set Cl1 = Cl1.Offset(Cl) End If: Next End Sub

Bác có thể code dùm em thêm 1 cột mã nằm đầu tiên được không.Cám ơn bác

sealand · 10/9/10

Bạn Kiểm tra giùm nha

phuteo · 14/9/10

sealand đã viết:
Nếu vậy thì chỉ cần như thế này thôi, khi nhập xong sang sheet Report là có

Mã:

Sub PrintMark() Dim Cl As Range, Cl1 As Range Application.ScreenUpdating = False Rp.Range("A2", Rp.[f56536].End(xlUp)).Clear Set Cl1 = Rp.[A2] For Each Cl In DT.Range("G2", DT.[g65536].End(xlUp)) If Cl > 0 Then Cl1.Resize(Cl, 6).Value = Range(Cl.Offset(, -6), Cl.Offset(, -1)).Value Set Cl1 = Cl1.Offset(Cl) End If: Next End Sub

Mình cần nhờ bạn code lại dùm để khi chuyển sang sheet report thì dữ liệu có định dạng là TEXT và còn 1 vấn đề nữa là bạn có thể code sao cho sheet report được cập nhật theo đúng số dòng cần in. VD: Nếu in tem A với sl là 10 sau đó in tem B với sl là 5 thì mặc định máy vẫn in ra là 10 nhưng từ tem thứ 6 trở đi là trắng không có gì.Cám ơn bạn

sealand · 15/9/10

Chắc là chỉ có 2 dạng dữ liệu phải chuyển đổi đó là
-Dạng số
-Dạng ngày giờ

Bạn chép code này thay vào code trong file đã

Mã:

Sub PrintMark()
   Dim Cl As Range, Cl1 As Range, Cl2 As Range
     Application.ScreenUpdating = False
       Rp.Range("A2", Rp.[G56536].End(xlUp)).Clear
       Set Cl1 = Rp.[A2]
          For Each Cl In DT.Range("H2", DT.[H65536].End(xlUp))
        If Cl > 0 Then
       Cl1.Resize(Cl, 7) = Range(Cl.Offset(, -7), Cl.Offset(, -1)).Value
     For Each Cl2 In Cl1.Resize(Cl, 7)
   If IsDate(Cl2) Then Cl2 = WorksheetFunction.Text(Cl2, "dd/mm/yyyy")
  If IsNumeric(Cl2) Then Cl2 = "'" & Cl2
 Next
 Set Cl1 = Cl1.Offset(Cl)
End If: Next
End Sub

Khi chuyển sang Text thì định dạng có thay đổi. Vậy bạn phải dự kiến định dang cho 2 dạng này.

Còn vấn đề số lượng trang in thì phải kiểm tra lại yêu cầu dữ liệu đầu vào ra sao chứ ở đây VBA chỉ thay bạn chép theo từng loại đúng với số dòng như bạn chép tay mà thôi

phuteo · 15/9/10

Về định dạng TEXT thì ok rùi nhưng còn sl in thì giống như bạn có 1000 dòng công thức mặc dù không có dữ liệu thì khi in file đó ra sẽ vẫn lên số trang đủ 1000 dòng nhưng lại là trang trắng.Cám ơn nhiều

sealand · 16/9/10

Mình đã kiểm tra không có công thức nào trên Rp cả (Bạn có thể dùng lệnh goto để kiểm tra). Để chắc ăn không xóa sót data bạn thay code sau giùm :

Sub PrintMark()
Dim Cl As Range, Cl1 As Range, Cl2 As Range
Application.ScreenUpdating = False
Rp.Cells.Clear
DT.[a1:g1].Copy Rp.[a1]
Set Cl1 = Rp.[A2]
For Each Cl In DT.Range("H2", DT.[H65536].End(xlUp))
If Cl > 0 Then
Cl1.Resize(Cl, 7) = Range(Cl.Offset(, -7), Cl.Offset(, -1)).Value
For Each Cl2 In Cl1.Resize(Cl, 7)
If IsDate(Cl2) Then Cl2 = WorksheetFunction.Text(Cl2, "dd/mm/yyyy")
If IsNumeric(Cl2) Then Cl2 = "'" & Cl2
Next
Set Cl1 = Cl1.Offset(Cl)
End If: Next
End Sub

Rồi Test lại xem sao

phuteo · 25/9/10

sealand đã viết:
Mình đã kiểm tra không có công thức nào trên Rp cả (Bạn có thể dùng lệnh goto để kiểm tra). Để chắc ăn không xóa sót data bạn thay code sau giùm :

Sub PrintMark()
Dim Cl As Range, Cl1 As Range, Cl2 As Range
Application.ScreenUpdating = False
Rp.Cells.Clear
DT.[a1:g1].Copy Rp.[a1]
Set Cl1 = Rp.[A2]
For Each Cl In DT.Range("H2", DT.[H65536].End(xlUp))
If Cl > 0 Then
Cl1.Resize(Cl, 7) = Range(Cl.Offset(, -7), Cl.Offset(, -1)).Value
For Each Cl2 In Cl1.Resize(Cl, 7)
If IsDate(Cl2) Then Cl2 = WorksheetFunction.Text(Cl2, "dd/mm/yyyy")
If IsNumeric(Cl2) Then Cl2 = "'" & Cl2
Next
Set Cl1 = Cl1.Offset(Cl)
End If: Next
End Sub

Rồi Test lại xem sao

Cám ơn bạn nhiều chương trình chạy rât good.Bạn tạo thêm dùm mình 1 button bên sheet report để gọi chương trinh in tem lên và hướng dẫn luôn cách trỏ tới đường dẫn của chương trình in tem nhé.Cám ơn bạn rất nhiều vì sự giúp đỡ nhiệt tình

sealand · 25/9/10

Vì mình không biết file chạy của chương trình in bạn để ở đâu nên mình viết mẫu chương trình chạy Winword. Bạn xem đường dẫn của chương trinh in như thế nào rồi sửa lại đường dẫn vào chỗ của Winword nha:

Mã:

Private Sub CommandButton1_Click()
Dim prin
prin = Shell("[COLOR=red]C:\Program Files\Microsoft Office\OFFICE11\WINWORD.EXE[/COLOR]", vbMaximizedFocus)
End sub

phuteo · 25/9/10

Mình gà mờ về code lắm nên đưa file lên bạn sửa cho minh nhé,mình đưa đường dẫn của chương trình luôn C:\Program Files\lmwdemo\Lmw.exe.Cám ơn bạn

sealand · 25/9/10

Bạn kiểm tra lại nha

phuteo · 25/9/10

Mình gửi nhầm đường dẫn.Vì file mình cần mở phải dùng chương trình đó mới được, còn đường dẫn tới file đó là "D:\In_tem\In_ma_vach\Tem gia.qdf" nhung khi mình thay đường dẫn vào thì báo lỗi.Bạn sửa dùm làm sao để có thể gọi thẳng file đó lên vì mặc định mình đã cho file đó được mở bằng chương trình C:\Program Files\lmwdemo\Lmw.exe rồi.Cám ơn bạn nhiều

sealand · 25/9/10

Thế thì bạn chỉ cần gắn cho nó 1 cái HypeLink là được

phuteo · 11/11/10

Bạn có thể code thêm vào file dùm mình sao cho lúc nhap sl vào cột sl bên sheet Nhap thì khi chuyển sang sheet Xuat số dòng sẽ nhân len gấp đôi.VD sl bên sheet Nhap là 5 thì khi chyển sang sheet Xuat sẽ cho ra 10 dòng thay vì 5 dòng như hiện tại.Cám ơn bạn nhiều nhé

Chèn dòng dựa vào giá trị của cell.

Thành viên mới

File đính kèm

Gội rồi mới Cạo

Thành viên mới

File đính kèm

Gội rồi mới Cạo

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

File đính kèm

Đếm ngược thời gian