Tức là cháu có cột A họ tên nhưng mà có những khoảng trống vì vây các hàm Vlookup không tìm được
Thì bạn cứ nói rõ ngay từ đầu rằng "Tôi muốn dùng code để xóa những khoảng trắng thừa trong dữ liệu". Chỉ vậy thôi là được chứ gì mà chèn cột với chèn dòng ở đây?
Sub TrimAll()
Dim aShs, item, aSource, rngSource As Range
Dim wks As Worksheet
Dim lRow As Long
aShs = Array("70", "80", "90")
For Each item In aShs
Set wks = Worksheets(item)
Set rngSource = wks.Range("A1", wks.Range("A60000").End(xlUp))
aSource = rngSource.Value
For lRow = 1 To UBound(aSource)
If aSource(lRow, 1) <> Empty Then
aSource(lRow, 1) = WorksheetFunction.Trim(aSource(lRow, 1))
End If
Next
rngSource.Value = aSource
Next
End SubSub Macro1()
Dim Ws As Worksheet
Dim Names() As Variant
Dim i As Integer
For Each Ws In Worksheets
If InStr("70 80 90", Ws.Name) > 0 Then
Names = Ws.Range("a1", Ws.Range("a1000000").End(xlUp))
For i = 1 To UBound(Names)
If Names(i, 1) = "" Then Exit For
Next i
Ws.Range("a1").Resize(UBound(Names), 1).ClearContents
Ws.Range("a1").Resize(i, 1) = Names
End If
Next Ws
End SubBác ơi cháu cảm ơn bác, nhưng trình độ của cháu chưa thể sử dụng được, bác làm cho cháu bằng công thức như cháu đã ghi Macro đi bác
Em cảm ơn anh,
Người ta gợi ý cho "cái tốt" không xài lại thích xài cái "tào lao"
Bạn chạy thử macro này xem sao
Sub Macro6()
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=IF(LEN(RC[-1])>0,1,0)"
Selection.AutoFilter
Range("B1").Select
ActiveSheet.Range("$B$1:$B$60").AutoFilter Field:=1, Criteria1:="=1", _
Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
End SubBác ơi, cháu biết là bác quá cao và cao thủ , đã giúp cho cháu,
Bác ơi, cháu biết là bác quá cao và cao thủ , đã giúp cho cháu,
Anh ơi. em đã dùng hàm "Trim; rùi nó cắt các khoảng trắng đầu và đuôi tại sao anh nghĩ phức tạp như vậy?
Tại thấy vùng số lieu cột A còn ô trống nên mới dùng autofilter xóa luôn các ô thừa. Tiện thể bạn xem luôn về auto filter mà áp dụng
Người ta muốn cắt những khoảng trắng thừa cho chuỗi (giống như hàm TRIM) chứ không phải là xóa các ô trống đâu
Nhìn lại thấy rõ rồi anh ạ. Nhưng mà chắc cũng chịu không làm được nữa.
Sub TrimAll()
Dim aShs, item, aSource, rngSource As Range
Dim wks As Worksheet
Dim lRow As Long
aShs = Array("70", "80", "90")
For Each item In aShs
Set wks = Worksheets(item)
Set rngSource = wks.Range("A1", wks.Range("A60000").End(xlUp))
aSource = rngSource.Value
For lRow = 1 To UBound(aSource)
If aSource(lRow, 1) <> Empty Then
aSource(lRow, 1) = WorksheetFunction.Trim(aSource(lRow, 1))
End If
Next
rngSource.Value = aSource
Next
End Sub
Chắc sửa thêm 1 chút như vầy. Bạn xem thử nha
Sub TrimAll()
Dim aShs, item, aSource, rngSource As Range
Dim wks As Worksheet
Dim lRow As Long, J As Long
aShs = Array("70", "80", "90")
For Each item In aShs
Set wks = Worksheets(item)
Set rngSource = wks.Range("A1", wks.Range("A60000").End(xlUp)).Resize(, 3)
aSource = rngSource.Value
For lRow = LBound(aSource, 1) To UBound(aSource, 1)
For J = LBound(aSource, 2) To UBound(aSource, 2)
If aSource(lRow, J) <> Empty Then
aSource(lRow, J) = WorksheetFunction.Trim(aSource(lRow, J))
End If
Next J
Next lRow
rngSource.Value = aSource
Next
End SubCode báo lỗi tại dòng
Set wks = Worksheets(item)Mình không chạy được code, nhờ VetMini chỉ giúp.
Nếu chỉ có dữ liệu dòng 1 code không chịu xóa
Phiền nhỉ. Tạm chữa cháy thế này. Viết cho nó thật đúng thì dài dòng quá.
