quangthanhdu
Thành viên chính thức
- Tham gia
- 21/5/10
- Bài viết
- 51
- Được thích
- 4
Thử đại cái này xem sao, trúng trật hên xui, có gì bàn tiếpMọi người giúp mình viết code cho nút "CHEN HANG", nội dung như file excel.Chân thành cảm ơn...
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Vung, Cll, Dk, VungDk, I
Dk = "POLE"
Set VungDk = Range([a2], [a500].End(xlUp)).Offset(0, 1)
Set Vung = Range([l1], [l100].End(xlUp))
For Each Cll In Range([a2], [a500].End(xlUp))
I = Application.WorksheetFunction.CountA(VungDk)
If Cll = Dk Then
Cll.Offset(1, 0).EntireRow.Insert
Cll.Offset(1, 11).Delete Shift:=xlUp
Cll.Offset(1, 1) = Vung(I + 1)
End If
Next
Application.ScreenUpdating = True
End Sub
Option Explicit
[B]Sub AddRows()[/B]
Dim jJ As Long, eRw As Long: Const GPE As String = "POLE"
Dim WF, Cls As Range, Rng As Range: Dim Timer_ As Double
Timer_ = Timer
eRw = [A65500].End(xlUp).Row: Application.ScreenUpdating = False
Set WF = Application.WorksheetFunction
eRw = eRw + WF.CountIf([A1].Resize(eRw), GPE)
For Each Cls In [a2].Resize(eRw)
If Cls.Value = "POLE" Then
jJ = 1 + jJ: Set Rng = Cells(jJ, "L")
With Cls.Offset(1)
.EntireRow.Insert
.Offset(-1, 1).Value = IIf(Rng.Value <> "", Rng.Value, "GPE " & jJ)
End With
End If
Next Cls
[E65500].End(xlUp).Offset(1).Value = Timer - Timer_
End Sub
Sub TimVaThemDong()
Dim jJ As Long, eRw As Long: Const GPE As String = "POLE"
Dim WF, Cls As Range, Rng As Range, sRng As Range:
Dim Timer_ As Double, MyAdd As String
Timer_ = Timer: Application.ScreenUpdating = False
Set Rng = Range([A1], [A65500].End(xlUp))
Set Cls = Rng.Find(GPE, , xlFormulas, xlWhole)
If Not Cls Is Nothing Then
MyAdd = Cls.Address
Do
jJ = jJ + 1: Set sRng = Cells(jJ, "L")
With Cls.Offset(1)
.EntireRow.Insert
.Offset(-1, 1).Value = IIf(sRng.Value <> "", sRng.Value, "GPE " & jJ)
End With
Set Cls = Rng.FindNext(Cls)
Loop While Not Cls Is Nothing And Cls.Address <> MyAdd
End If
[H65500].End(xlUp).Offset(1).Value = Timer - Timer_
End Sub
Private Sub CommandButton1_Click()
Dim TmpRng As Range
Application.ScreenUpdating = False
With Range([A1], [A65536].End(xlUp))
.AutoFilter 1, "POLE"
Set TmpRng = Intersect(.Cells, .Offset(1)).SpecialCells(12)
.AutoFilter
TmpRng.Offset(1).Insert 2
TmpRng.Offset(1, 1) = "=INDIRECT(""L""&COUNTIF(R1C1:RC1,""POLE""))"
.Offset(, 1).Value = .Offset(, 1).Value
End With
Application.ScreenUpdating = True
End Sub