Anh ơi, copy cái đoạn code của anh vào đâu hả anh. Anh thông cảm, em biết ít kiến thức lắm. Em chỉ biết copy code đã viết sẵn rồi dùng thui
Không biết code mà cứ thích dùng code.
Sub DisplayedToActual()
'Updateby20131126
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Hoc Excel Online"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For Each Rng In WorkRng
If Rows(Rng.Row).EntireRow.Hidden = False Then
Rng.Value = Rng.Text
End If
Next
Application.ScreenUpdating = True
End SubEm cám ơn anh. Cho em hỏi ngu thêm câu nữa là, em có sưu tầm đc 2 code để phục vụ công việc ( code này là cái thứ 3 ) em muốn nó thành 1 tool add in (hoặc 3 tool riêng biệt cũng được) trên thanh toolbar để dùng khi cần thì làm như thế nào ạ. Hiện tại cần gì em toàn phải xoá cái cũ đi để thêm cái mới vào
Cần lên khung search và gõ tool addin bạn
Nếu bạn muốn lưu làm công cụ để tiện thao tác bạn lưu file tên là.XLSA
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 Sub
