Thử code này cho vui, cũng không hiểu rõ ý
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
If [C3] <> "" Then
If [F6] <> "" Then
With Sheet1.[E65536].End(3).Offset(1)
.Value = [C3]
.Offset(, 2) = [F6]
.Offset(, -4) = .Row - 2
If .Offset(1, -3) <> "" Then
.Offset(1).EntireRow.Insert
End If
End With
End If
End If
End If
End SubCam on anh Quang Hai.
*** Chú ý viết tiếng Việt có dấu đàng hoàng
Thử lại thế này.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$3" Then
If [C8] <> "" And [H13] <> "" Then
Dim tim As Range
Set tim = Sheet1.[A8:A100].Find("")
If Not tim Is Nothing Then
With tim
.Value = .Row - 8
.Offset(, 4) = [C8]
.Offset(, 6) = [H13]
If .Offset(1, 1) <> "" Then
.Offset(1).EntireRow.Insert
End If
End With
End If
End If
End If
End SubCám ơn anh Hải, code đã chạy được, tuy nhiên khi copy sang thì nó in đậm, có câu lệnh nào bỏ không ạ.
Đâu phải do code, do bạn định dạng font in đậm trước cả vùng dữ liệu, bạn định dạng lại bên sheet"bang ke" là được .
Thực ra bạn không nhờ tôi nhưng hôm qua đã trót giúp rồi thì giúp luôn! Lưu ý là các dòng bên dưới bảng như "CBKH đã kiểm tra....","....". sẽ bị mất, khi nào muốn in thì bạn đánh lại hoặc bạn lưu vào đâu đó khi cần thì copy sang!
Mình chưa bạn ạ, do ngày nay mình đi công việc, tối mình test rồi báo lại bạn.
Sub "thu" mình viết riêng bên Module1, bạn có chép theo không ?
Bạn đưa dữ liệu thật hoặc giống như thật lên để mọi người giúp . Nếu bạn thêm bớt dữ liệu để xem cách cách mọi người sử lý code thì ...trên diễn đàn nhiều lắm rồi đó bạn .
File của bạn sheet2 không cách dòng( liên tục ) thì điều kiện chạy code là BK, sheet3 có cách dòng điều kiện chạy là BK1. Bạn chạy code file tải về có lỗi không ? Tốt nhất là bạn đưa file đang lỗi của bạn lên, và nói rõ yêu cầu lần nữa .
Thử code này coi sao. Code theo kiểu file thật của bạn. Nếu đừng có vướng mấy dòng thông tin bên dưới dòng tổng thì code sẽ gọn hơn.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$3" Then
Select Case UCase(Target)
Case "BK", "BK1"
Dim tim As Range, str As String, sh As String
str = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng"
sh = IIf(UCase(Target) <> "BK", "Bang ke 1", "Bang ke")
Set tim = Sheets(sh).[b:b].Find(str)
If Not tim Is Nothing Then
If tim.Offset(-2, -1) <> "" Then tim.EntireRow.Insert
With tim.Offset(, -1).End(3).Offset(1)
.Value = Application.Max(.Offset(-1).Resize(3)) + 1
.Offset(, 4) = [C8]
.Offset(, 6) = [H13]
If UCase(Target) = "BK1" Then
If .Value > 1 Then .Resize(2).EntireRow.Insert
End If
End With
End If
End Select
End If
End SubBạn chuột nói đúng, file của bạn thay đổi tùm lum số cột, điều kiện... nói chung, làm sao mà code không lỗi . Nếu không phải mình bảo bạn đưa file lên, mình sẽ không làm . Lần sau nếu bạn nhờ nên cân nhắc kỹ biểu mẫu rồi đưa lên . Làm mới thì lâu và sửa code của chuột dò mờ cả mắt.
Giúp bạn nốt vậy . Bạn xem file
Bạn xóa hết dữ liệu cũ và chạy từ đầu xem nào ? Mình kiểm tra có sao đâu, để ý xem số TT thay đổi, hoặc thay đổi số liệu cho dễ nhận ra sự thay đổi . Bạn thêm câu lệnh nữa thì xuất hiện 2 lần là đúng rồi . Mà bạn dùng bản nào thế ? Bạn tải lại file về và nhớ đổi tên cho đỡ nhầm file . File cuối có tên là "Bang ke_3b".
Bạn sửa dòng lệnh thứ 7 thành :
Mình Không để ý dán câu lệnh nó lại thay đổi ClearContents thành ClearContentsòn cha mẹ ơi ! cho mình xin lỗi nhé! Vì nội dung copy sau xóa nguồn nên không xóa được, chỉ xóa phần chữ ký và phụ đề bên dưới dữ liệu để cập nhật lại . Không biết có sai gì không bạn ?
Bạn định dạng lại font cho bảng tính của bạn kể cả sheet nguồn và đích ( nhớ cả khu vực không có dữ liệu xem sao, tự nhiên nó không đổi font mà vì trước đó đã được định dạng font rồi )
Bạn xem file sau nhé !
