Giúp tạo Macro

D

dang uy

Sơ cấp
Chào cộng đồng Webketoan
các Pro giúp e tạo macro nhé
em có file đính kèm bên dưới:
gồm 3 sheet:
- sheet định nghĩa + sheet 1 + sheet 2
em muốn tạo một marco tìm kiếm điều kiện từ sheet định nghĩa sang sheet 1 + 2, và xóa dữ liệu không tìm thấy
vd: điều kiện sheet định nghĩa là team 01.Hai Phong, thì sang sheet 1 + 2 chỉ giữ lại hàng có tên 01. Hai Phòng và xóa bỏ các dữ liệu còn hàng còn lại..
Mong các Pro giúp em
Tks!
 

Đính kèm

dang uy nói:
Chào cộng đồng Webketoan
các Pro giúp e tạo macro nhé
em có file đính kèm bên dưới:
gồm 3 sheet:
- sheet định nghĩa + sheet 1 + sheet 2
em muốn tạo một marco tìm kiếm điều kiện từ sheet định nghĩa sang sheet 1 + 2, và xóa dữ liệu không tìm thấy
vd: điều kiện sheet định nghĩa là team 01.Hai Phong, thì sang sheet 1 + 2 chỉ giữ lại hàng có tên 01. Hai Phòng và xóa bỏ các dữ liệu còn hàng còn lại..
Mong các Pro giúp em
Tks!
Nhấn để mở rộng...
Tức là những gì được khai báo trong bảng định nghĩa thì bên Sheet1 , 2 sẽ được dữ lại hàng chứa giá trị đó. Còn lại sẽ xóa đúng ko?
 
dang uy nói:
cái này dùng vòng lặp tìm điều kiện thôi, nhưng mình lại không rành về code, nên mới hỏi pro ak
Nhấn để mở rộng...
Cấu trúc của bạn chưa chuẩn lắm ở chỗ bảng định nghĩa thì Ha Noi có dấu cách mà trong sheet 1, 2 có dấu cách
PHP: 
Sub DelNotLookup()
Dim i As Long, j As Long
Dim a1() As String, a2() As String
Dim ShDefine As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet
Set ShDefine = ThisWorkbook.Sheets("DinhNghia")
Set Sh1 = ThisWorkbook.Sheets("Sheet 1")
Set Sh2 = ThisWorkbook.Sheets("Sheet2")
Dim dDefine As Long, d1 As Long, d2 As Long, F As Long, p1 As Long, p2 As Long
dDefine = ShDefine.Range("A" & ShDefine.Rows.Count).End(xlUp).Row
d1 = Sh1.Range("C" & Sh1.Rows.Count).End(xlUp).Row
d2 = Sh2.Range("C" & Sh2.Rows.Count).End(xlUp).Row
For i = 2 To d1
    F = 0
    For j = 2 To dDefine
        If Sh1.Cells(i, 3).Value = ShDefine.Cells(j, 1).Value Then
            F = 1
            Exit For
        End If
    Next j
    If F = 0 Then
        p1 = p1 + 1
         ReDim Preserve a1(p1)
         a1(p1) = Sh1.Cells(i, 3).Address
    End If
Next i
For i = 1 To p1
    Sh1.Range(a1(i)).EntireRow.Delete
Next i
For i = 2 To d2
    F = 0
    For j = 2 To dDefine
        If Sh2.Cells(i, 3).Value = ShDefine.Cells(j, 1).Value Then
            F = 1
            Exit For
        End If
    Next j
    If F = 0 Then
        p2 = p2 + 1
         ReDim Preserve a2(p2)
         a2(p2) = Sh2.Cells(i, 3).Address
    End If
Next i
For i = 1 To p2
    Sh1.Range(a2(i)).EntireRow.Delete
Next i
End Sub
 
thinhvd nói:
Cấu trúc của bạn chưa chuẩn lắm ở chỗ bảng định nghĩa thì Ha Noi có dấu cách mà trong sheet 1, 2 có dấu cách
PHP: 
Sub DelNotLookup()
Dim i As Long, j As Long
Dim a1() As String, a2() As String
Dim ShDefine As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet
Set ShDefine = ThisWorkbook.Sheets("DinhNghia")
Set Sh1 = ThisWorkbook.Sheets("Sheet 1")
Set Sh2 = ThisWorkbook.Sheets("Sheet2")
Dim dDefine As Long, d1 As Long, d2 As Long, F As Long, p1 As Long, p2 As Long
dDefine = ShDefine.Range("A" & ShDefine.Rows.Count).End(xlUp).Row
d1 = Sh1.Range("C" & Sh1.Rows.Count).End(xlUp).Row
d2 = Sh2.Range("C" & Sh2.Rows.Count).End(xlUp).Row
For i = 2 To d1
    F = 0
    For j = 2 To dDefine
        If Sh1.Cells(i, 3).Value = ShDefine.Cells(j, 1).Value Then
            F = 1
            Exit For
        End If
    Next j
    If F = 0 Then
        p1 = p1 + 1
         ReDim Preserve a1(p1)
         a1(p1) = Sh1.Cells(i, 3).Address
    End If
Next i
For i = 1 To p1
    Sh1.Range(a1(i)).EntireRow.Delete
Next i
For i = 2 To d2
    F = 0
    For j = 2 To dDefine
        If Sh2.Cells(i, 3).Value = ShDefine.Cells(j, 1).Value Then
            F = 1
            Exit For
        End If
    Next j
    If F = 0 Then
        p2 = p2 + 1
         ReDim Preserve a2(p2)
         a2(p2) = Sh2.Cells(i, 3).Address
    End If
Next i
For i = 1 To p2
    Sh1.Range(a2(i)).EntireRow.Delete
Next i
End Sub
Nhấn để mở rộng...


em chạy ra nó bị lỗi anh ơi
upload_2016-12-6_15-18-53.png
 
Bạn phải đăng nhập hoặc đăng ký để bình luận.

Liên kết

Tâm An kế toán quản trị

Chia sẻ trang

Back
Top