NH_DK
Let's patience
- Tham gia
- 29/7/10
- Bài viết
- 865
- Được thích
- 1,204
- Nghề nghiệp
- Kế toán
AC xem dùm em code này:
AC chỉ dùm em chỗ sai!?
PHP:
Option Explicit
Sub Tao_So()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim eRw1 As Long, eRw2 As Long, FirstAddress As String, i As Long
Dim MyR As Range, TimCell As Range
Set ws1 = Sheets("Data")
Set ws2 = Sheets("SCAI")
Application.ScreenUpdating = False
ws2.Range("A11:G65535").Clear
eRw1 = ws1.Range("A65535").End(xlUp).Row
eRw2 = ws2.Range("A65535").End(xlUp).Row
Set MyR = ws1.Range("F5:G" & eRw1)
Set TimCell = MyR.Find(what:=[D3] & "*", after:=.[F4], LookIn:=xlValues, _
LookAt:=xlWhole, searchorder:=xlByRows)
If Not TimCell Is Nothing Then
FirstAddress = TimCell
i = 11
Do
Cells(i, 1).Resize(, 4) = ws1.Cells(TimCell.Row, 1).Resize(, 4).Value
Select Case TimCell.Column
Case 6
Cells(i, 5) = TimCell.Offset(, 1).Value
Cells(i, 6) = TimCell.Offset(, 2).Value
Case 7
Cells(i, 5) = TimCell.Offset(, -1).Value
Cells(i, 7) = TimCell.Offset(, 2).Value
End Select
i = i + 1
Set TimCell = MyR.FindNext(TimCell)
Loop While FirstAddress <> TimCell.Address
End If
If i > 11 Then Rows(i & eRw2).EntireRow.Hidden = True
Set TimCell = Nothing: Set MyR= Nothing
Set ws1 = Nothing: Set ws2 = Nothing
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối:
