Code tìm và xóa dòng dữ liệu từ sheet khác (1 người xem)

quoc nhat · 15/10/15

Kính nhờ các anh chị viết giúp em đoạn code tìm và xóa dòng dữ liệu ở sheet khác từ một điều kiện cho trước
Nội dung em có ghi trên File đính kèm
Em cảm ơn nhiều
http://www.mediafire.com/view/mubxwrig908pnle/data1.xls

quoc nhat · 15/10/15

em sưu tầm được đoạn code xóa dòng nhưng khổ nỗi nó chỉ xóa 1 lần 1 dòng thôi
các anh chị xem giúp

Mã:

Sub Button1_Click()
Dim fRng As Range, sRng As Range
    Set fRng = Sheet11.Range("g:g").Find([sp], , xlValues, xlWhole) ' [sp] name ô màu vàng
  If Not fRng Is Nothing Then
    fRng.EntireRow.Delete
    End If
    MsgBox ("XONG"), , ""
End Sub
[CODE]

comet_1701 · 15/10/15

quoc nhat đã viết:
Kính nhờ các anh chị viết giúp em đoạn code tìm và xóa dòng dữ liệu ở sheet khác từ một điều kiện cho trước
Nội dung em có ghi trên File đính kèm
Em cảm ơn nhiều
http://www.mediafire.com/view/mubxwrig908pnle/data1.xls

Bạn thử xem có được ko

PHP:

Sub Delete()
    Dim LR, i&
    LR = Sheet11.UsedRange.Rows.Count
    For i = 1 To LR
        Do While (StrComp(Sheet11.Cells(i, 7), Sheet1.[D5], vbTextCompare) = 0)
            Rows(i).Select
            Selection.Delete Shift:=xlUp
       Loop
    Next i
End Sub

quoc nhat · 15/10/15

comet_1701 đã viết:
Bạn thử xem có được ko

PHP:

Sub Delete() Dim LR, i& LR = Sheet11.UsedRange.Rows.Count For i = 1 To LR Do While (StrComp(Sheet11.Cells(i, 7), Sheet1.[D5], vbTextCompare) = 0) Rows(i).Select Selection.Delete Shift:=xlUp Loop Next i End Sub

Màn hình nháy mãi không ngừng anh ơi
Có Code nào nhanh hơn không anh?

comet_1701 · 15/10/15

quoc nhat đã viết:
Màn hình nháy mãi không ngừng anh ơi
Có Code nào nhanh hơn không anh?

PHP:

Sub Xoadong()
Dim I As Long, LR, Sarr
Sar = Sheet11.Range("G3:G1000")
For I = 1 To UBound(Rng)
    If InStr(Rng(I, 1), Sheet1.Range("D5"), vbBinaryCompare) Then
        Rows(I).Delete shift:=xlUp
    End If
Next I
Mình gửi nhầm


End Sub

Bạn thử đoạn này xem có ổn ko

quoc nhat · 15/10/15

comet_1701 đã viết:
PHP:

Sub Xoadong() Dim I As Long, LR, Sarr Sar = Sheet11.Range("G3:G1000") For I = 1 To UBound(Rng) '(Sar) If InStr(Rng(I, 1), Sheet1.Range("D5"), vbBinaryCompare) Then' Range("D4") Rows(I).Delete shift:=xlUp End If Next I Mình gửi nhầm End Sub

Bạn thử đoạn này xem có ổn ko

Báo lỗi ở dòng màu đỏ, mình thay (Sar) vào nhưng không thấy nó xóa được

comet_1701 · 15/10/15

quoc nhat đã viết:
Báo lỗi ở dòng màu đỏ, mình thay (Sar) vào nhưng không thấy nó xóa được

PHP:

Sub Delete()
    Dim LR, I&
    LR = Sheet11.Range("G3:G1000")
    For I = 1 To UBound(LR)
        Do While (StrComp(Sheet11.Cells(I, 7), Sheet1.[D5], vbTextCompare) = 0)
            Rows(I).Select
            Selection.Delete shift:=xlUp
       Loop
    Next I
End Sub

chắc dữ liệu thật còn nhiều, file của bạn thì mình te st bình thường, ở trên mình ghi là gửi nhầm mà

doveandrose · 15/10/15

cho góp vui văn nghệ tí với các đồng chí . hi hi

Mã:

Public Sub hello()
Dim lr As Long
With Sheet11
    .Range("G2:H2").AutoFilter
    lr = .[G65000].End(xlUp).Row
    .Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value
    If .[G65000].End(xlUp).Row > 2 Then
        .Range("G3:H" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "khong tim thay " & Sheet1.[D5].Value
    End If
    .Range("G2:H2").AutoFilter
End With
End Sub

quoc nhat · 15/10/15

comet_1701 đã viết:
PHP:

Sub Delete() Dim LR, I& LR = Sheet11.Range("G3:G1000") For I = 1 To UBound(LR) Do While (StrComp(Sheet11.Cells(I, 7), Sheet1.[D5], vbTextCompare) = 0) Rows(I).Select Selection.Delete shift:=xlUp Loop Next I End Sub

chắc dữ liệu thật còn nhiều, file của bạn thì mình te st bình thường, ở trên mình ghi là gửi nhầm mà

Để mình kiểm tra lại xem sao

quoc nhat · 15/10/15

doveandrose đã viết:

cho góp vui văn nghệ tí với các đồng chí . hi hi

Mã:

Public Sub hello()
Dim lr As Long
With Sheet11
    .Range("G2:H2").AutoFilter
    lr = .[G65000].End(xlUp).Row
    .Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value
    If .[G65000].End(xlUp).Row > 2 Then
        .Range("G3:H" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "khong tim thay " & Sheet1.[D5].Value
    End If
    .Range("G2:H2").AutoFilter
End With
End Sub

Code chuẩn rồi anh ơi
Cảm ơn các anh nhiều

comet_1701 · 15/10/15

doveandrose đã viết:

cho góp vui văn nghệ tí với các đồng chí . hi hi

Mã:

Public Sub hello()
Dim lr As Long
With Sheet11
    .Range("G2:H2").AutoFilter
    lr = .[G65000].End(xlUp).Row
    .Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value
    If .[G65000].End(xlUp).Row > 2 Then
        .Range("G3:H" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "khong tim thay " & Sheet1.[D5].Value
    End If
    .Range("G2:H2").AutoFilter
End With
End Sub

Lúc dầu mình cũng nghĩ đến phương thức specialcells nhưng sợ khi xóa những dòng liên quan bị mất, test thử thấy hay, cảm ơn bạn

comet_1701 · 15/10/15

quoc nhat đã viết:
Kính nhờ các anh chị viết giúp em đoạn code tìm và xóa dòng dữ liệu ở sheet khác từ một điều kiện cho trước
Nội dung em có ghi trên File đính kèm
Em cảm ơn nhiều
http://www.mediafire.com/view/mubxwrig908pnle/data1.xls

Thêm một cách nhỏ nữa, dùng Auto Filter, gần giống bài #8

PHP:

Sub Xoa_dong()
Dim Ws As Worksheet
Dim Rng As Range
Set Ws = Sheets("DATA")
Set Rng = Ws.Range(Ws.[G2], Ws.[G65000].End(xlUp))
Application.ScreenUpdating = False
    With Ws
        .AutoFilterMode = False
        Rng.AutoFilter Field:=1, Criteria1:=Sheet1.[D5]
        Rng.Offset(1, 0).EntireRow.Delete
        .AutoFilterMode = False
    End With
Application.ScreenUpdating = True
End Sub

doveandrose · 15/10/15

comet_1701 đã viết:

Thêm một cách nhỏ nữa, dùng Auto Filter, gần giống bài #8

PHP:

Sub Xoa_dong()
Dim Ws As Worksheet
Dim Rng As Range
Set Ws = Sheets("DATA")
Set Rng = Ws.Range(Ws.[G2], Ws.[G65000].End(xlUp))
Application.ScreenUpdating = False
    With Ws
        .AutoFilterMode = False
        Rng.AutoFilter Field:=1, Criteria1:=Sheet1.[D5]
        Rng.Offset(1, 0).EntireRow.Delete
        .AutoFilterMode = False
    End With
Application.ScreenUpdating = True
End Sub

bạn làm tôi thấy ghen tị đấy . Code viết trông rất bài bản . Tôi cũng muốn viết được như bạn mà hổng được . Code tôi viết trông nó cứ cà chớn thế nào ấy . +-+-+-+

Ở trên tôi cố ý filter trên 1 range có 2 cột vì lắm lúc khai báo range có 1 cột (trong khi bảng thật có rất nhiều cột ) nó lại báo lỗi .
tôi cũng chẳng có thời gian đi hỏi tại sao lỗi nên cứ khai báo 2 cột vậy . Mình bị té thì báo trước cho các bạn biết mà né thôi . hi hi

quoc nhat · 16/10/15

Chào các anh chị. Chúc các anh chị ngày mới tốt lành!
Hôm qua em có nhờ các anh chị viết giúp code dò tìm và xóa với 1 điều kiện
Hôm nay em có nãy sinh thêm vấn đề nữa muốn nhờ sự trợ giúp của mọi người với điều kiện xóa là 2
Nội dung em có ghi trên file đính kèm
Nhờ các anh chị xem giúp
http://www.mediafire.com/view/9fdddpbfdc67zyz/Copy_of_data1.xls

P/S: Đúng là lòng tham con người không bao giờ tính được -0-/.

doveandrose · 16/10/15

quoc nhat đã viết:
Chào các anh chị. Chúc các anh chị ngày mới tốt lành!
Hôm qua em có nhờ các anh chị viết giúp code dò tìm và xóa với 1 điều kiện
Hôm nay em có nãy sinh thêm vấn đề nữa muốn nhờ sự trợ giúp của mọi người với điều kiện xóa là 2
Nội dung em có ghi trên file đính kèm
Nhờ các anh chị xem giúp
http://www.mediafire.com/view/9fdddpbfdc67zyz/Copy_of_data1.xls

P/S: Đúng là lòng tham con người không bao giờ tính được

tìm đến dòng

Mã:

.Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value

sửa lại thành

Mã:

.Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value
.Range("G2:H" & lr).AutoFilter 2, Sheet1.[D3].Value

quoc nhat · 16/10/15

doveandrose đã viết:
tìm đến dòng

Mã:

.Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value

sửa lại thành

Mã:

.Range("G2:H" & lr).AutoFilter 1, Sheet1.[D5].Value .Range("G2:H" & lr).AutoFilter 2, Sheet1.[D3].Value

Nhanh thật
Nhưng dòng nào trùng số phiếu và có ngày bên cạnh thì xóa được còn không thì xóa không được :.,

nếu có thêm hộp thoại Msgbox thông báo thì càng tốt anh nhỉ
"Trùng số phiếu nhưng không trùng ngày"
"Trùng ngày không trùng số phiếu"
----> Kiểm tra lại
cảm ơn anh!

quoc nhat · 16/10/15

hpkhuong đã viết:
Xóa theo điều kiện, thỏa nó xóa. không thỏa...thì nó không làm. Đơn giản vậy thôi, Msgbox làm gì cho nó khựng khựng lại không biết...

Đã dò theo 2 điều kiện là 1 thỏa, 2 là không. Thỏa là xóa. Không thì nó im ru....vậy hok khỏe hơn ah???

Em biết là vậy mà anh
chỉ vì cùng một phiếu nhưng chỉ có một dòng có đánh ngày còn các dòng khác không đánh ngày vào thì kg xóa được anh à!

Cá ngừ F1 · 16/10/15

Theo chủ quan của tôi bài này không nên dùng code để xóa.
Sheet Data không nên động vào vì là dữ liệu gốc bạn nhập, nếu mà xóa đi thì lần sau lấy dữ liệu báo cáo từ đâu.
Chỉ nên làm thêm 1 sheet báo cáo, cần lọc theo cột nào thì lây theo cột đó. Còn sheet Data để nguyên.

quoc nhat · 16/10/15

Cá ngừ F1 đã viết:
Theo chủ quan của tôi bài này không nên dùng code để xóa.
Sheet Data không nên động vào vì là dữ liệu gốc bạn nhập, nếu mà xóa đi thì lần sau lấy dữ liệu báo cáo từ đâu.
Chỉ nên làm thêm 1 sheet báo cáo, cần lọc theo cột nào thì lây theo cột đó. Còn sheet Data để nguyên.

Thực ra em xóa số phiếu đó đi để sửa ghi lại cái khác có cùng số phiếu đó sau đó dùng code để sort lại
Nếu không khả thi như vậy thì đành bỏ ý định hôm nay thôi

doveandrose · 16/10/15

quoc nhat đã viết:
Thực ra em xóa số phiếu đó đi để sửa ghi lại cái khác có cùng số phiếu đó sau đó dùng code để sort lại
Nếu không khả thi như vậy thì đành bỏ ý định hôm nay thôi

phần bạn đưa lên để hỏi chỉ giống như phần nổi của tảng băng , thì người khác làm sao hiểu được ý bạn
việc sửa và xóa 1 số phiếu nào đó là việc quá đơn giản để code . Nhưng phải nêu rõ yêu cầu đầy đủ . Bạn cần làm 10 việc mà bạn nêu lên diễn đàn có 3 việc rồi nói rằng không khả thi rồi bỏ luôn ý định . vậy thì chỉ có bạn thiệt thòi

Code tìm và xóa dòng dữ liệu từ sheet khác (1 người xem)

Người dùng đang xem chủ đề này

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

hello

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

hello

Thành viên tiêu biểu

hello

Thành viên tiêu biểu

Thành viên tiêu biểu

( ͡° ͜ʖ ͡°)

Thành viên tiêu biểu

hello

Đếm ngược thời gian