Giúp mình thiết kế macro cho nút nhập

Liên hệ QC

nmhung49

Thành viên tích cực
Tham gia
20/8/09
Bài viết
1,186
Được thích
1,337
mình có một file mà không biết làm sao để thiết kế macro cho nó vì kiến thức bên VBA có hạn mong các bạn giúp mình cụ thế là khi mình nhấn vào nút nhận thì dử liệu sẽ đươc nhập trong sheet khác mình có ghi rõ những yêu cầu trong file minh gủi mong các bạn xem giúp. Thanks
 
Chỉnh sửa lần cuối bởi điều hành viên:
Macro của bạn đây

PHP:
Private Sub CommandButton1_Click()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Code As Range, Clls As Range, rRng As Range
 Dim eRw As Long, Jj As Long
 
 Sheet1.Select:                              Set Sh = Sheet2
 Set Rng = Sh.Range(Sh.[b1], Sh.[iv1].End(xlToLeft))
 eRw = [A65500].End(xlUp).Row
 Set Code = Sh.Range(Sh.[A2], Sh.[A65500].End(xlUp))
 'Cot Cua Ngày Càn Chép:'
 Set sRng = Rng.Find([g1].Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   For Each Clls In Range([A3], [A65500].End(xlUp))
      Set rRng = Code.Find(Clls.Value)
      If Not rRng Is Nothing Then
         Sh.Cells(rRng.Row, sRng.Column).Resize(, 4).Value = _
            Clls.Offset(, 1).Resize(, 4).Value
      End If
   Next Clls
 End If
End Sub

Còn cái vụ:
Đặt biệt là khi hôm nay mình không sản xuất sản phẩm đó nhưng ngày
khác mình có sản xuất thì làm sao để chèn thêm sheet 2
Chưa hiểu hết ý, chưa làm; Nhưng đoán là phải 1 macro riêwng cho vụ này

Nếu bạn không rành copy macro cho vô nút lệnh thì nói nha; Mình sẽ cung cấp file đính kèm (Hao tài nguyên lắm!)
 
Cảm ơn bạn nhiều

Mình cảm ơn bạn nhiều đoạn code của bạn chạy rất chính xác nhưng mà khi tui thêm 2 sản phẩm mới sản xuất thêm ở dòng bên dưới thì nhấn nút "nhập" thì qua bên sheet 2 không có 2 sản phẩm mới đó vậy mình phải làm sao. Mình có upload file đính kèm bạn giúp mình với nhen. Mà mình muốn hiện "thông báo đã nhập rồi" nếu ngày đó dữ liệu bên sheet 2 đã có cho nút lệnh đó thì làm sao.
 
Nhưng khi thêm 2 sản phẩm mới sản xuất thêm ở dòng bên dưới thì nhấn nút "nhập" thì qua bên sheet 2 không có 2 sản phẩm mới đó vậy mình phải làm sao.
Mình có upload file đính kèm bạn giúp mình với nhen.

Đặt biệt là khi hôm nay mình không sản xuất sản phẩm đó nhưng ngày
khác mình có sản xuất thì làm sao để chèn thêm sheet 2
nó chưa chịu chép vì bên Sheet2 chưa có Code đó
Muốn nó chép, thì áp dụng 1 trong các cách sau:

(1) Nhập tay vô Sheet2 tại cột 'A'

(2) Lấy trang tính mới để liệt kê toàn bộ các Code SF, mình hay ai đó sẽ giúp bạn thêm 1 macro nữa. Khi đó, ta kích hoạt trang tính Sheet1 thì các cột Code sẽ được cập nhật từ trang tính lưu Code này

(3) . . . .

Mà mình muốn hiện "thông báo đã nhập rồi" nếu ngày đó dữ liệu bên sheet 2 đã có cho nút lệnh đó thì làm sao.

Bạn chèn thêm các dòng lệnh vô giữa 2 dòng mờ (vì có rồi) sau xem sao:

Mã:
[COLOR=silver]If Not sRng Is Nothing Then 'Da Co'[/COLOR]
   If Sh.Cells(65500, sRng.Column).End(xlUp).Row > sRng.Row Then
      MsgBox "Da Nhap Roi!", , "GPE Xin Thong Bao:"
      Exit Sub
   End If
   [COLOR=silver]For Each Clls In Range([A3], [A65500].End(xlUp)) 'Da Co'[/COLOR]
 
Macro này xài được hơn đó

Macro này sẽ chép Code & số liệu của nó chưa có trong trang tính Sheet2 sang đó.
Bạn thử đi nha!


PHP:
Option Explicit
Private Sub CommandButton1_Click()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Code As Range, Clls As Range, rRng As Range
 Dim eRw As Long, Jj As Long
 
 Sheet1.Select:                              Set Sh = Sheet2
 Set Rng = Sh.Range(Sh.[b1], Sh.[iv1].End(xlToLeft))
 eRw = [A65500].End(xlUp).Row
 
 Set Code = Sh.Range(Sh.[A2], Sh.Range("A" & Sh.[A65500].End(xlUp).Row + eRw))
 'Cot Cua Ngày Càn Chép:'
 Set sRng = Rng.Find([g1].Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   If Sh.Cells(65500, sRng.Column).End(xlUp).Row > sRng.Row Then
      MsgBox "Da Nhap Roi!", , "GPE Xin Thong Bao:"
      Exit Sub
   End If
   For Each Clls In Range([A3], [A65500].End(xlUp))
      Set rRng = Code.Find(Clls.Value)
      If Not rRng Is Nothing Then
         Sh.Cells(rRng.Row, sRng.Column).Resize(, 4).Value = _
            Clls.Offset(, 1).Resize(, 4).Value
      Else
         With Sh.[A65500].End(xlUp).Offset(1)
            .Value = Clls.Value
            Sh.Cells(.Row, sRng.Column).Resize(, 4).Value = _
               Clls.Offset(, 1).Resize(, 4).Value
         End With
      End If
   Next Clls
 End If
End Sub
 
xem dùm code

Anh chị xem giúp dùm e đoạn code này sao em chọn ngay 31 nhấn nút nhập mà không được vậy sao nó chỉ nhận tới ngày 30 thôi hà
Mã:
Private Sub CommandButton1_Click()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Code As Range, Clls As Range, rRng As Range
 Dim eRw As Long, Jj As Long
 
 Sheet1.Select:                              Set Sh = Sheet2
 Set Rng = Sh.Range(Sh.[b1], Sh.[iv1].End(xlToLeft))
 eRw = [A65500].End(xlUp).Row
 Set Code = Sh.Range(Sh.[A2], Sh.[A65500].End(xlUp))
 'Cot Cua Ngày Càn Chép:'
 Set sRng = Rng.Find([g1].Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   For Each Clls In Range([A3], [A65500].End(xlUp))
      Set rRng = Code.Find(Clls.Value)
      If Not rRng Is Nothing Then
         Sh.Cells(rRng.Row, sRng.Column).Resize(, 4).Value = _
            Clls.Offset(, 1).Resize(, 4).Value
      End If
   Next Clls
 End If
End Sub
 
Tại VBA không ưa ô trộn í mà, hi, hi, . . .

Bạn sửa dòng lệnh này

Mã:
 Set Rng = Sh.Range(Sh.[b1], Sh.[iv1].End(xlToLeft)[B].Offset(, 4)[/B])
Phần được tô đậm là phần phải thêm!

Chúc vui!
 
sao mình chưa nhập mà báo là nhập rồi

mình có chép đoạn code của anh HYen vào thì mình chưa nhập dữ liệu vào thì nó hiện lên thông báo đã nhập rồi anh HYen và Chanh coi giúp em với
 
Web KT

Bài viết mới nhất

Back
Top Bottom