Xin giúp mình Code để copy cột theo điều kiện dò tìm

Liên hệ QC

dieptnhuynh

Thành viên mới
Tham gia
13/5/13
Bài viết
3
Được thích
0
Giới tính
Nữ
Điệp có nhiều Mã Hàng tại sheet ThongTin. Với mỗi Mã hàng được đánh "dấu x" thì sẽ đi dò tìm Mã Hàng bên sheet Dữ Liệu (dò tại dòng 1 sheet Dữ Liệu). Với tất cả cột có xuất hiện mã hàng này trong sheet Dữ Liệu thì sẽ được copy từ dòng 3 đến dòng cuối để dán qua sheet Report và gửi sheet Report này sẽ được vào email được quy định trong sheet ThôngTin.
Điệp có attached file để anh chị rõ hơn. Xin giúp mình nhé ! Cảm ơn ạ.
 

File đính kèm

  • CopyCot-TheoDieuKien.xlsb
    91.9 KB · Đọc: 15
Kiểu này chắc bạn nhờ từ A đến Z. Tại sao bạn không nói là bạn định gửi Report ở dạng tập tin đính kèm hay ở dạng chèn nội dung của nó vào nội dung thư? Chả nhẽ người ta viết cho bạn rồi sửa lại?
 
Upvote 0
Kiểu này chắc bạn nhờ từ A đến Z. Tại sao bạn không nói là bạn định gửi Report ở dạng tập tin đính kèm hay ở dạng chèn nội dung của nó vào nội dung thư? Chả nhẽ người ta viết cho bạn rồi sửa lại?
Mình gửi email dạng attached file bạn ạ. Thật ra mình dỡ ẹc vba luôn á, mình chỉ có thể search tìm code các bạn khác hướng dẫn vụ gửi mail. Nhưng search hoài chưa thấy bài hướng dẫn cách lọc dữ liệu theo điều kiện cột hết, đa số thấy xử lí theo dòng nên mình loay hoay không biết làm sao. Cảm ơn Batman nha.
 
Upvote 0
Nhờ các Bạn giúp mình code tìm kiếm kiếm và sao chép dử liệu theo điều kiện chuyển từ sheets("BK_NX") sang Sheets("THEKHO").
trong file mình đang dùng code. Nhưng thấy code chạy hơi chậm.
Bạn nào có code hay giúp mình với nhé!
 

File đính kèm

  • THUCHANH.xlsm
    2.8 MB · Đọc: 7
Upvote 0
Nhờ các Bạn giúp mình code tìm kiếm kiếm và sao chép dử liệu theo điều kiện chuyển từ sheets("BK_NX") sang Sheets("THEKHO").
trong file mình đang dùng code. Nhưng thấy code chạy hơi chậm.
Bạn nào có code hay giúp mình với nhé!
Thử với:
PHP:
Sub Test()
    Application.ScreenUpdating = False
    Dim a(), b(), i, j, k, DK, LR
    With Sheets("BK_NX")
        a = .Range("A6", .Range("B65000").End(3)).Resize(, 14).Value
        LR = UBound(a)
    End With
    ReDim b(1 To LR, 1 To 11)
    With Sheets("BK_NX")
        DK = Sheets("THEKHO").Range("G4").Value
        For i = 1 To LR
            If a(i, 8) = DK Then
                k = k + 1
                b(k, 1) = k: b(k, 2) = a(i, 2): b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 4): b(k, 5) = a(i, 5): b(k, 6) = a(i, 10)
                b(k, 7) = a(i, 11): b(k, 8) = "": b(k, 9) = a(i, 12)
                b(k, 10) = "": b(k, 11) = ""
            End If
        Next i
        With Sheets("THEKHO")
            .Range("A11:k1000").Clear
            .Range("A11:k1000").Borders.LineStyle = 0
        End With
        If k Then
            With Sheets("THEKHO")
                .Range("A11").Resize(k, 11) = b
                .Range("A11").Resize(k, 11).Borders.LineStyle = 1
            End With
        End If
    End With
End Sub
 
Upvote 0
Cảm ơn Bạn đã chia sẻ. Nhưng do trong file trên sheet("THEKHO") cột H, J , K > Mình đang lồng công thức để tính. Bạn xem chỉnh sửa lại giúp mình với nhé
 
Upvote 0
Cảm ơn Bạn đã chia sẻ. Nhưng do trong file trên sheet("THEKHO") cột H, J , K > Mình đang lồng công thức để tính. Bạn xem chỉnh sửa lại giúp mình với nhé
Có thấy công thức nào đâu mà chỉnh sửa.
Bạn lập công thức sẵn luôn đi, để người khác viết nó trong VBA luôn.
 
Upvote 0
cảm ơn Bạn đã chỉ cho mình thêm ý tưởng này.
Mình gửi lại file có chứa công thức trên cột H , J , K
 

File đính kèm

  • THUCHANH.xlsm
    2.8 MB · Đọc: 13
Upvote 0
giúp mình cái này nữa. Sau khi chạy code. Định dạng ngày tháng năm trên cột C giống như Mình đã gửi trong file.
 
Upvote 0
cảm ơn Bạn đã chỉ cho mình thêm ý tưởng này.
Mình gửi lại file có chứa công thức trên cột H , J , K
Thử:
PHP:
Sub Test2()
    Application.ScreenUpdating = False
    Dim a(), b(), i, j, k, DK, LR, LRow
    With Sheets("BK_NX")
        a = .Range("A6", .Range("B65000").End(3)).Resize(, 14).Value
        LR = UBound(a)
    End With
    ReDim b(1 To LR, 1 To 11)
    With Sheets("BK_NX")
        DK = Sheets("THEKHO").Range("G4").Value
        For i = 1 To LR
            If a(i, 8) = DK Then
                k = k + 1
                b(k, 1) = k: b(k, 2) = a(i, 2): b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 4): b(k, 5) = a(i, 5): b(k, 6) = a(i, 10)
                b(k, 7) = a(i, 11)
                b(k, 9) = a(i, 12)
            End If
        Next i
        With Sheets("THEKHO")
            .Range("A11:k1000").ClearContents
            .Range("A11:k1000").Borders.LineStyle = 0
        End With
        If k Then
            With Sheets("THEKHO")
                .Range("A11").Resize(k, 11) = b
                .Range("A11").Resize(k, 11).Borders.LineStyle = 1
            End With
        End If
    End With
    With Sheets("THEKHO")
        LRow = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("H11:H" & LRow).Formula = "= IF(B11="""","""",SUM($F$11:F11)-SUM($G$11:G11))"
        .Range("J11:J" & LRow).Formula = "=IF(COUNTIF($I$11:I11,I11)=1,I11,"""")"
        .Range("K11:K" & LRow).Formula = "=IF(J11="""","""",SUMIF($I$11:$I$1100,J11,$F$11:$F$1100)-SUMIF($I$11:$I$1100,J11,$G$11:$G$1100))"
        .Range("H11:H" & LRow).Value = .Range("H11:H" & LRow).Value
        .Range("J11:J" & LRow).Value = .Range("J11:J" & LRow).Value
        .Range("K11:K" & LRow).Value = .Range("K11:K" & LRow).Value
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Công nhận có chuyên gia giúp sức nên có khác.
Cảm ơn Bạn thật nhiều. Code này đúng là hoản hảo
Bài đã được tự động gộp:

Bạn ơi. Giúp mình thêm định dạng ngày tháng năm.
Mình chạy code quá tuyệt rồi. Nhờ giúp thêm phần định dạng ngày tháng năm ở cột C nữa.
Vì sau khi chạy code phần định dạng ở cột C làm mất đi ngày tháng năm như trongfile mình trình bày
 
Lần chỉnh sửa cuối:
Upvote 0
Công nhận có chuyên gia giúp sức nên có khác.
Cảm ơn Bạn thật nhiều. Code này đúng là hoản hảo
Bài đã được tự động gộp:

Bạn ơi. Giúp mình thêm định dạng ngày tháng năm.
Mình chạy code quá tuyệt rồi. Nhờ giúp thêm phần định dạng ngày tháng năm ở cột C nữa.
Vì sau khi chạy code phần định dạng ở cột C làm mất đi ngày tháng năm như trongfile mình trình bày
Bạn thêm dòng:
PHP:
.Range("C11:C" & LRow).NumberFormat = "d/m/yyyy;@"
Lại cụ thể này:
PHP:
Option Explicit
Sub Test3()
    Application.ScreenUpdating = False
    Dim a(), b(), i, j, k, DK, LR, LRow
    With Sheets("BK_NX")
        a = .Range("A6", .Range("B65000").End(3)).Resize(, 14).Value
        LR = UBound(a)
    End With
    ReDim b(1 To LR, 1 To 11)
    With Sheets("BK_NX")
        DK = Sheets("THEKHO").Range("G4").Value
        For i = 1 To LR
            If a(i, 8) = DK Then
                k = k + 1
                b(k, 1) = k: b(k, 2) = a(i, 2): b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 4): b(k, 5) = a(i, 5): b(k, 6) = a(i, 10)
                b(k, 7) = a(i, 11)
                b(k, 9) = a(i, 12)
            End If
        Next i
        With Sheets("THEKHO")
            .Range("A11:k10000").Clear
            .Range("A11:k10000").Borders.LineStyle = 0
        End With
        If k Then
            With Sheets("THEKHO")
                .Range("A11").Resize(k, 11) = b
                .Range("A11").Resize(k, 11).Borders.LineStyle = 1
            End With
        End If
    End With
    With Sheets("THEKHO")
        LRow = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("H11:H" & LRow).Formula = "= IF(B11="""","""",SUM($F$11:F11)-SUM($G$11:G11))"
        .Range("J11:J" & LRow).Formula = "=IF(COUNTIF($I$11:I11,I11)=1,I11,"""")"
        .Range("K11:K" & LRow).Formula = "=IF(J11="""","""",SUMIF($I$11:$I$1100,J11,$F$11:$F$1100)-SUMIF($I$11:$I$1100,J11,$G$11:$G$1100))"
        .Range("H11:H" & LRow).Value = .Range("H11:H" & LRow).Value
        .Range("J11:J" & LRow).Value = .Range("J11:J" & LRow).Value
        .Range("K11:K" & LRow).Value = .Range("K11:K" & LRow).Value
        .Range("C11:C" & LRow).NumberFormat = "d/m/yyyy;@"
    End With
End Sub
 
Upvote 0
Bạn thêm dòng:
............................
Có nhiều người khoái dùng "Clear", sau đó phải định dạng lại Font, Bold, Number Format, Border.... đủ thứ, khổ vậy?
Ví dụ Cột Z tôi Format trước nó là Text, chỉ cần ClearContents, gán Value lại thì nó vẫn là Text.
 
Upvote 0
Cảm ơn bác Ba Tê, em sửa:
PHP:
            .Range("A11:k10000").Clear
bằng
PHP:
            .Range("A11:K10000").ClearContents
 
Upvote 0
Web KT
Back
Top Bottom