Tạo Macro trích lọc dữ liệu

  • Thread starter Thread starter ST-Lu!
  • Ngày gửi Ngày gửi
Liên hệ QC
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
BẠN THỬ CHẠY ĐOẠN CODE NÀY XEM KẾT QUẢ THẾ NÀO NHÉ
PHP:
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Code chạy ngon quá bác boy xịn ơi (mỗi tội trong đó chưa có đoạn TRIM)


Em nên viết lại code này như nào (vì cái vụ Range("C2:C1000")
Em cứ chọn 1000 cho nhiều nhưng thực tế nó chỉ vài trăm thôi
Sub 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
Cám ơn bác nhiều. Code viết rất dễ hiểu

ST
 
Lần chỉnh sửa cuối:
Upvote 0
Code 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
Về nguyên lý, cái này phải lọc 2 lần
1/ Chỉ lấy những Bill bắt đầu = KKLUHPH1 và ADDCHGS POP Chỉ lấy cảng HAIPHONG
Gắn vào Tmp (2 điều kiện)
2/ Chỉ lấy những Bill bắt đầu = KKLUHPH1 và Prepaid At = HAIPHONG & số tiền tại cột Prepaid <> 0 (3 điều kiện)
Như vậy dùng AutoFilter khó. Phải là AdFilter hay là Find Method.
 
Upvote 0
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

Em xin được hỏi đoạn code trên sai ở đâu?
 
Upvote 0
Vẫn là macro trích lọc dữ liệu (nhưng thêm tính tổng có điều kiện)

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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Gợi ý:
- Nếu làm bằng tay thì đương nhiên bạn sẽ dùng AutoFilter để lọc
- Vậy khi viết thành code sao không dựa trên cơ sở AutoFilter mà làm? Cần gì For cho lâu
Bài này nhớ không lầm đã có nói rồi
Còn nữa: Cái vụ TRIM ấy chỉ sau khi lọc xong ---> xóa hết dử liệu không thỏa mã đ/k ---> ShowAll Data thì ta mới cho chạy For (tiết kiệm số lần quét)
 
Upvote 0
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
Bạn chạy đoạn code này và kiểm tra lại kết quả nhé
PHP:
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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

Chỗ nào cần mà chưa chuyển TEXT về số?
Sorry, không để ý phần khai báo biến (cứ tưởng các số đó là số nguyên, không có phần thập phân)
Bạn sửa chút xíu phần khai báo biến như sau

Dim Rng As Range, Str As String, idate As String
Dim Tmp, i As Long, Er As Long
 
Upvote 0
Em 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

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
 
Lần chỉnh sửa cuối:
Upvote 0
Em 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
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ến
PHP:
Dim Rng As Range, Str As String, idate As String, i As Long, Er As Long, Tmp As Long
Thành
PHP:
Dim Rng As Range, Str As String, idate As String
Dim Tmp, idate As String, i As Long, Er As Long
Rồi chạy sẽ thấy khác

---------------------------------------------------
Từ Hải Phòng --(34km)-> Lai Khê --(2km)-> Cầu Lai:
Đến Lai Khê thì rẽ phải 2km qua 1 con sông rồi qua 3km nữa là đến nơi boyxin rồi
 
Upvote 0
to boyxin
Xin cho hỏi cách lọc theo bài trên nhưng copy ra sheet khác (giữ nguyên dữ liệu ban đầu )thì phải làm thế nào. Cảm ơn bạn nhiều.
 
Upvote 0
File có macro sang máy tính khác không chạy được

Dear các anh chị,
Em có điều này không biết nhờ các anh chị chỉ giúp.
Em tạo file macro trên máy tính của mình nhưng khi qua máy tính khác mở file thì chạy không được (mặc dù đã chép code vào máy tính đó, nhưng không biết chép code có đúng không?). Các anh chị chỉ giúp cách chép code như thế nào?
Có cách nào không cần chép code mà qua máy tính khác vẫn chạy được macro đó không? Chép thấy dùng bất tiện quá.
Cám ơn các anh chị nhiều.
 
Upvote 0
Bạn thử vào Tools -> Marco > Security> chọn Medium xem sao
Chúc thành công
 
Upvote 0
Lọc danh sách theo yêu cầu

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!;;;;;;;;;;;
 

File đính kèm

Upvote 0
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!;;;;;;;;;;;
Thử code này xem:
PHP:
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
 

File đính kèm

Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom