BẠN THỬ CHẠY ĐOẠN CODE NÀY XEM KẾT QUẢ THẾ NÀO NHÉEm đang tập tành ghi macro, các anh xem file và chỉ dạy giúp em
Cám ơn các anh
Sub GPE_Loc()
Dim Er As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Sheets("Lifting Results").Select
Range("A:A,C:C,H:S,U:W,Z:AB,AD:AD").Select
Selection.Delete Shift:=xlToLeft
Set Rng = [A1].CurrentRegion
Rng.AutoFilter Field:=1, Criteria1:="<>KKLUHPH1*"
Rng.Offset(1).SpecialCells(12).EntireRow.Delete
Selection.AutoFilter
Er = [A6500].End(xlUp).Row
For i = 2 To Er
Tmp = Trim(Cells(i, 1))
Cells(i, 1) = Tmp
If Cells(i, 8) = "HAIPHONG" Then
Cells(i, 1).EntireRow.Hidden = True
Else
If Cells(i, 9) = "HAIPHONG" And Cells(i, 6) <> 0 Then
Cells(i, 1).EntireRow.Hidden = True
End If
End If
Next
Set Rng = [A1].CurrentRegion
Rng.Offset(1).SpecialCells(12).EntireRow.Delete
Rng.EntireRow.Hidden = False
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
[A1].Select
End Sub
Cám ơn bác nhiều. Code viết rất dễ hiểuSub Trim()
'
' Trim Macro
' Macro recorded 23/10/2008 by Vu Van Sang
'
Range("C2").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1000")
Range("C2:C1000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Về nguyên lý, cái này phải lọc 2 lầnCode chạy ngon quá bác boy xịn ơi (mỗi tội trong đó chưa có đoạn TRIM)
Cám ơn bác nhiều. Code viết rất dễ hiểu
ST
Dim Ir As Long
Ir = [A10000].End(xlUp).Row
Range("C2").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C&ir")
Range("C2:C&ir").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Mong MOD move giúp em bài này vào đúng vị trí
Lần sau hứa ko tái phạm
----------------------------------
Rất cám ơn Boyxin đã viết giúp đoạn code (ở bài gửi trước)
Do trình độ có hạn nên ST rất mong các anh viết hộ đoạn code (như trong file đính kèm)
Rất cám ơn anh chị
ST
Option Explicit
Dim Rng As Range, Str As String, idate As String, i As Long, Er As Long, Tmp As Long
Sub GPE_Loc()
Sheets(2).Select
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Range("A:A,C:C,E:G,J:M,O:O,Q:Q").Select
Selection.Delete Shift:=xlToLeft
Set Rng = [A1].CurrentRegion
Rng.AutoFilter Field:=7, Criteria1:="<>C"
Rng.Offset(1).SpecialCells(12).EntireRow.Delete
Selection.AutoFilter
Er = [A65536].End(xlUp).Row
For i = 2 To Er
idate = Mid(Cells(i, 8), 1, 10)
Cells(i, 8) = idate
Str = Trim(Cells(i, 1))
Cells(i, 1) = "KKLU" & Str
Tmp = Cells(i, 6)
If Cells(i, 1) = Cells(i - 1, 1) Then
Tmp = Tmp + Cells(i - 1, 6)
Cells(i - 1, 7).ClearContents
Cells(i, 6) = Tmp
End If
Cells(i, 6) = Tmp
Next
Range("G2:G" & Er).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range([A1], Selection.End(xlDown)).Columns.AutoFit
[A1].Select
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Anh ơi code chạy tốt lắm
Công thức tính tổng (kiểu sumif rất hay, sáng tạo)
Nhưng em chưa thấy code chuyển định dạng TEXT về số nhỉ?
Nhưng còn một tí tẹo nữa là ngon, do định dạng cũ từ mạng lấy xuống
ví dụ: Tại sheet gốc (chưa chạy Macro: tại P341 & P346 có định dạng số là
38.12 và 66.88
Nhưng khi anh chuyển về địng dạng số --> nó thành 3812 và 6688 nên tổng tiền của em bị sai
Bác thêm đoạn code find(.) và replace giúp em thành (,) với
Cám ơn bác
Option Explicit
Dim Rng As Range, Str As String, idate As String, i As Long, Er As Long, Tmp As Long
Sub GPE_Loc()
Sheets(2).Select
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Range("A:A,C:C,E:G,J:M,O:O,Q:Q").Select
Selection.Delete Shift:=xlToLeft
Set Rng = [A1].CurrentRegion
Rng.AutoFilter Field:=7, Criteria1:="<>C"
Rng.Offset(1).SpecialCells(12).EntireRow.Delete
Selection.AutoFilter
Er = [A65536].End(xlUp).Row
For i = 2 To Er
idate = Mid(Cells(i, 8), 1, 10)
Cells(i, 8) = idate
Str = Trim(Cells(i, 1))
Cells(i, 1) = "KKLU" & Str
Tmp = Cells(i, 6)
If Cells(i, 1) = Cells(i - 1, 1) Then
Tmp = Tmp + Cells(i - 1, 6)
Cells(i - 1, 7).ClearContents
Cells(i, 6) = Tmp
End If
Cells(i, 6) = Tmp
Next
Range("G2:G" & Er).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range([A1], Selection.End(xlDown)).Columns.AutoFit
[A1].Select
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Tmp As LongEm xem lại code có gì khác đâu vẫn khai báo vậy mà?
Dim tmp, i as longCác anh ơi, em tưởng 2 cách khai báo trên là giống nhau chứ nhỉ?
Hic, (chưa quen thì nhìn không thấy khác nhau là mấy) cứ thay đoạn khai báo biếnEm xem lại code có gì khác đâu vẫn khai báo vậy mà? anh chạy xong để ý ở phần FRT AMT đó
Thôi dù sao thế cũng ác lắm rồi
---------------
Ngoài lề chút:
- Em về Thanh Hà Hải Duơng (ngay chân cầu Lai) thì đã qua Kinh Môn Chưa hả bác
Dim Rng As Range, Str As String, idate As String, i As Long, Er As Long, Tmp As Long
Dim Rng As Range, Str As String, idate As String
Dim Tmp, idate As String, i As Long, Er As Long
Thử code này xem:Tôi có một file chứa dữ liệu tổng hợp về học lực và hạnh kiểm của học sinh cuối năm học (ở sheet1).
Tôi muốn sau khi nhập các dữ liệu ở sheet1 song thì ở sheet2 có một danh sách các em học sinh đạt danh hiệu học sinh giỏi; ở sheet3 có một danh sách các em học sinh đạt danh hiệu học sinh khá; ....
Làm thế nào? Các bạn giúp tôi với nhé!
Thank you very much!
Sub Trichloc()
Dim i As Long
Sheets("hsg").[A6:G1000].Clear
Sheets("HSTT").[A6:G1000].Clear
With Sheets("lop").[A6].CurrentRegion
For i = 1 To 2
.AutoFilter 4, Choose(i, "G", "K"): .AutoFilter 5, "T"
.SpecialCells(12).Copy Destination:=Sheets(Choose(i, "hsg", "HSTT")).[A6]
Next i
End With
Sheets("lop").AutoFilterMode = False
End Sub