Xem file
Nội dung theo dõi về tố cáo, khiếu nại trước đây (khoảng 7 năm) tôi viết hẳn 1 File theo dõi cho cơ quan, nhưng rất tiếc cơ quan không dùng (lý do đã có phần mềm theo dõi), để tôi tìm lại và sửa cho phù hợp cái bạn cần. Vậy, bạn hãy chờ tôi tìm (giờ không nhớ để nó ở cái xó nào).
Em cám ơn anh, em chưa thấy ở đâu mọi người nhiệt tình như ở GPE
Em cám ơn anh. Nhưng mỗi lần em xuất file từ phần mềm ra excel tên sheet sẽ không là "Before" và "After" ( em đặt vậy để trình bày cho mọi người dễ hiểu ). Có cách nào mà mình chạy thì nó cho sang sheet mới không anh ? Cột mã số em làm text to colums theo cột cũng nhanh thôi.
Tên sheet xuất từ phần mềm cố định hay thay đổi? tên sheet tạo mới đặt tên như thế nào?
Vậy thì bạn nên đưa vài cái File xuất từ phần mềm ra excel lên đây thử xem, biết quy luật thì mới tính tiếp được.
Tên sheet thì sẽ là tên file mình đặt, mình đặt gì cũng đc. Chỉ có 1 sheet duy nhất giống như sheet “before” đó ạ. Tuy nhiên nếu hiện tại ( dùng code của anh HieuCD ) khi em export file mới, em sẽ phải xoá các cột đi để lấy đc hàng tiêu đề mẫu và copy sang sheet mới và đặt tên là after. Em cám ơn
Sub CopyData()
Dim Rng As Range
Dim Id As Long, i As Long, lRow As Long
Const Str = "Personnel Number:"
Application.ScreenUpdating = False
Sheets("Before").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "After" & Sheets.Count - 1 'Chinh lai tên Sheet
lRow = Range("C" & Rows.Count).End(xlUp).Row
Set Rng = Cells(1, 1)
For i = 2 To lRow
If Cells(i, 2) = Str Then Id = Cells(i, 7)
If IsNumeric(Mid(Cells(i, 3), 1, 2)) Then
Cells(i, 2) = Id
Else
If i <> 11 Then Set Rng = Union(Rng, Cells(i, 1))
End If
Next i
Rng.EntireRow.Delete
Range("A:A,E:E,I:I,N:N,P:P,R:X,Z:Z,AB:AB,AD:AF,AO:AQ,BA:BA").EntireColumn.Delete
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
Code vậy không được vì sẽ bị tham chiếu vòng. Cứ gán giá trị trực tiếp luôn thay vì gán công thức
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row >= 9 And Target.Row <= 16 Then
If Target.Column = 6 Then Target.Offset(, -2).Value = Target.Value
If Target.Column = 4 Then Target.Offset(, 2).Value = Target.Value
End If
Application.EnableEvents = True
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row >= 9 And Target.Row <= 16 Then
If Target.Column = 6 Then
With Target.Offset(, -2)
.FormulaR1C1 = "=INDEX(R9C10:R16C10,MATCH(RC[2],R9C11:R16C11,0))"
.Value = .Value
End With
End If
If Target.Column = 4 Then
With Target.Offset(, 2)
.FormulaR1C1 = "=INDEX(R9C11:R16C11,MATCH(RC[-2],R9C10:R16C10,0))"
.Value = .Value
End With
End If
End If
Application.EnableEvents = True
End SubCảm ơn bạn.
Tôi chưa rảnh để tìm File, bạn vào tải File ở bài 130 của Link sau xem có dùng được không? Tôi nghĩ thêm bớt 1 chút là dùng được.
Vẫn quan điểm ở trên: Tuyệt đối không nên gán công thức vào Target khi thực hiện sự kiện Change (dễ bị lỗi) mà nên tính toán trực tiếp trong code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngFind As Range, cel As Range
Dim lOffset1 As Long, lOffset2 As Long, lOffset3 As Long
Application.EnableEvents = False
On Error Resume Next
If Target.Row >= 9 And Target.Row <= 16 Then
If Target.Column = 4 Then lOffset1 = 1
If Target.Column = 6 Then lOffset1 = -1
If lOffset1 Then
lOffset2 = (1 - lOffset1) / 2
lOffset3 = lOffset1 * 2
For Each cel In Target
If cel.Column = 4 Or cel.Column = 6 Then
Set rngFind = Range("DANHSACH").Resize(, 1).Offset(, lOffset2).Find(cel.Value, , xlValues, xlWhole)
If Not rngFind Is Nothing Then
cel.Offset(, lOffset3).Value = rngFind.Offset(, lOffset1).Value
Else
cel.Offset(, lOffset3).ClearContents
End If
End If
Next
End If
End If
If Err.Number Then MsgBox Err.Description
Application.EnableEvents = True
End Sub
With ShTrangChu.Range("g3:g66" & [f66].End(3).Row)
.Value = "=IF(RC[-1]=0,0,HLOOKUP(R2C2,Data!R2C3:R180C250,MATCH(RC[-1],Data!R2C2:R198C2,0),0))"
.Value = "'" & .Value
End With
