Nhờ viết Marco Copy với 3 điều kiện? (1 người xem)

[311280]

Nhờ các bác viết giúp e marco theo 3 điều kiện trong file đính kèm.Chân thành cảm ơn trước.

 

[hoangvuluan]

Dùng tạm macro sau:

Private Sub CommandButton1_Click()
Dim ra As Range, a()
Set ra = Me.Range("A16:E27") ' thay doi theo thuc te '
r = ra.Rows.Count
c = ra.Columns.Count
ReDim a(1 To r, 1 To c)
a = ra
    For i = 1 To r
        If a(i, 4) <> "" Or a(i, 5) <> "" Then
            For j = 1 To r
                If (j <> i) And a(i, 1) = a(j, 1) And a(i, 2) = a(j, 2) And a(i, 3) = a(j, 3) Then
                    a(j, 4) = a(i, 4)
                    a(j, 5) = a(i, 5)
                End If
            Next
        End If
    Next
ra = a
Set ra = Nothing
Erase a
End Sub

 

[ndu96081631]

Nhờ các bác viết giúp e marco theo 3 điều kiện trong file đính kèm.Chân thành cảm ơn trước.

Công thức cũng được vậy
- Quét chọn D16:E27
- Bấm F5, bấm tiếp nút Special và check mục Blanks, OK
- Gõ vào thanh Formula công thức

=LOOKUP(2,1/($A$16:$A17=$A18)/($B$16:$B17=$B18)/($C$16:$C17=$C18),D$16:D17)

- Bấm tổ hợp phím Ctrl + Enter
Xong!

 

[311280]

Nhờ các bác xem giúp e sửa lại file thì nó báo lỗi như trong file đính kèm

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[Ba Tê]

Nhờ các bác xem giúp e sửa lại file thì nó báo lỗi như trong file đính kèm

Nếu dữ liệu có quy luật như ví dụ thì thử với code này xem.

Private Sub CommandButton1_Click()
Dim Rng(), Arr(), I As Long, J As Long
    Rng = Sheet1.Range(Sheet1.[A16], Sheet1.[A65000].End(xlUp)).Resize(, 5).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 2)
    For I = 1 To UBound(Rng, 1)
        For J = 4 To 5
            If Rng(I, J) <> "" Then
                Arr(I, J - 3) = Rng(I, 4)
            Else
                Arr(I, J - 3) = Rng(I - 2, 4)
            End If
        Next J
    Next I
Sheet1.[D16].Resize(I - 1, 2).Value = Arr
End Sub