Sub chendong()Dim t As Long
t = Range("A56636").End(xlUp).Row
Rows(t).Insert Shift:=xlDown
End Sub
Bạn xem kỹ yêu cầu lại xem:
Hình như là trong 1 Cell có 3 dòng, thêm 1 dòng trống thành 4 dòng đấy.
Sub XoaCHR10()
Dim Rng As Range, Cls
Set Rng = Columns("A:A").SpecialCells(xlCellTypeConstants, 3)
For Each Cls In Rng
If Right(Cls.Value, 1) = Chr(10) Then
With Cls
.Value = Left(.Value, Len(.Value) - 1)
End With
End If
Next Cls
End Sub[B]Sub AddCHR10()[/B]
Dim Rng As Range, Cls
Set Rng = Columns("A:A").SpecialCells(xlCellTypeConstants, 3)
For Each Cls In Rng
Cls.Value = Cls.Value & Chr(10)
Next Cls
[B]End Sub[/B]
Dim Vtr As Byte, Lan As Byte, Jj As Byte, MyStr As String
VTr=1
For Jj = 1 to 99
If InStr(VTr , Cls.Value,CHR(10)) Then
VTr = InStr(VTr , Cls.Value,CHR(10)) + 1: Lan = Lan +1
If Lan = 2 Then
MyStr= Left( Cls.Value, Vtr -1) & Mid(Cls.Value,Vtr+1,99)
Exit For
End If
End If
Next Jj
. . . . .
Có phải bạn muốn xoá thế này
Sub xoa_xuongdong()
Dim cell
For Each cell In Selection
cell.Replace ChrW(10) & ChrW(10), ChrW(10)
If Right(cell, 1) = ChrW(10) Then
cell.Value = Left(cell, Len(cell) - 1)
End If
Next cell
End SubSub xoa_xuongdong()
Dim cell
For Each cell In Selection
cell.Replace ChrW(10) & ChrW(10) & ChrW(10) & ChrW(10), ChrW(10)
cell.Replace ChrW(10) & ChrW(10) & ChrW(10), ChrW(10)
cell.Replace ChrW(10) & ChrW(10), ChrW(10)
If Right(cell, 1) = ChrW(10) Then
cell.Value = Left(cell, Len(cell) - 1)
End If
Next cell
End Sub
Bạn chưa hiểu câu hỏi của tác giả thôi nên bạn cho là đơn giản!
Bác ơi, em đang làm một cái bảng mà nội dung của cũng có tính tương tự. VD như sau :
Gởi file lên đi, nói không khó xử lý lắm
ví dụ file đính kèm, từ bảng a chuyển thành bảng b
Code của các bậc cao thủ mang tính tổng quát thật
Thử code này coi sao.
Sub abc()
Dim nguon(), kq(1 To 10000, 1 To 6), i, j, k
nguon = Range([A3], [F65536].End(3).Offset(1)).Value
For i = 1 To UBound(nguon) - 1
k = k + 1
For j = 1 To 6
kq(k, j) = nguon(i, j)
Next
If nguon(i, 6) <> nguon(i + 1, 6) Then k = k + 1
Next
[H3].Resize(k, 6) = kq
End Sub
