Giúp xuất dữ liệu tham chiếu qua 1 cột bằng VBA theo dạng Danh mục

[HieuCD]

bạn test file xem đúng ý chưa

 

[ohho84]

@HieuCD: Vâng em đang xem anh ạ

 

[ohho84]

@HieuCD:
Anh ơi ở Sheet Người bán Em ko muốn in ra Cột I là Người bán A vì Cả sheet này là dành cho Người bán A rồi và Cột I là những text em điền vào mà ko muốn bị mất khi chạy Sub thì em sửa chỗ nào vậy anh ?

bạn test file xem đúng ý chưa

 

[HieuCD]

sửa đoạn màu đỏ

With Sheets(3)
Nban = .Range("A1")
.Range([COLOR=#ff0000]"A2:H20000"[/COLOR][COLOR=#ff0000][/COLOR]).ClearContents
End With
...
Next
    .Range([COLOR=#ff0000]"A2:H"[/COLOR] & .Range("B65000").End(xlUp).Row).Copy Sheets(3).Range("A2")
End With

 

[ohho84]

@HieuCD: Được rồi anh ạ. Cảm ơn anh rất nhiều. Anh có thể inbox em số điện thoại của anh hay bất cứ số điện thoại của ai mà anh quý mến được ko ạ. Em muốn gửi tặng 1 cái thẻ card vào đó. Dẫu biết anh giúp em tận tình ko tính toán gì nhưng em vẫn muốn cảm ơn anh ạ. Anh có thể nhắn ib em số đt bất kỳ nào mà anh muốn nạp ko ạ. Em cảm ơn anh rất nhiều.

sửa đoạn màu đỏ

With Sheets(3)
Nban = .Range("A1")
.Range([COLOR=#ff0000]"A2:H20000"[/COLOR]).ClearContents
End With
...
Next
    .Range([COLOR=#ff0000]"A2:H"[/COLOR] & .Range("B65000").End(xlUp).Row).Copy Sheets(3).Range("A2")
End With

 

[HieuCD]

@HieuCD: Được rồi anh ạ. Cảm ơn anh rất nhiều. Anh có thể inbox em số điện thoại của anh hay bất cứ số điện thoại của ai mà anh quý mến được ko ạ. Em muốn gửi tặng 1 cái thẻ card vào đó. Dẫu biết anh giúp em tận tình ko tính toán gì nhưng em vẫn muốn cảm ơn anh ạ. Anh có thể nhắn ib em số đt bất kỳ nào mà anh muốn nạp ko ạ. Em cảm ơn anh rất nhiều.

Được giúp bạn là mình vui rồi, chúc bạn luôn thành công trong công việc

 

[ohho84]

Dạ vâng. Có những mem như anh tụi gà như em mới có nơi bấu víu. Nhìu lúc hỏi nhiều quá cũng ngại anh ạ nhưng dốt lập trình nên ko biết làm sao. Cảm ơn anh rất nhiều ạ.
P/s: Em có chút vướng mắc ở đây http://www.giaiphapexcel.com/forum/...ệu-cùng-chú-thích-gắn-kèm&p=742540#post742540 Nếu có thể mong anh giúp em ạ Hix...

Được giúp bạn là mình vui rồi, chúc bạn luôn thành công trong công việc

 

[ohho84]

@HieuCD: Có cái lỗi này kỳ quặc anh ạ. Lỗi này là do Sub Nguoiban. Mỗi khi em vô tình click chuột vào 1 ô trống ( ô trống anh nhé) ở Sheet Tổng hợp thì run Sub Nguoiban y rằng báo lỗi. Lỗi này thật phiền toái anh ạ. Ko lẽ ở Sheet Tổng hợp mình ko được chạm vào cái gì sao... mà thực tế ở Sheet này công ty em còn nhập liệu thêm vào ở các cột khác nữa. Anh xem có cách nào fix giúp em ko ạ. Em vừa phải gỡ Sub ra khỏi file công ty vì lỗi này

bạn test file xem đúng ý chưa

 

[ohho84]

@HieuCD: Anh xem lại giúp em với ạ. Bị báo lỗi 400 ạnh ạ

Được giúp bạn là mình vui rồi, chúc bạn luôn thành công trong công việc

 

[ohho84]

Anh xem lại giúp em với ạ :
Có cái lỗi này kỳ quặc anh ạ. Lỗi này là do Sub Nguoiban. Mỗi khi em vô tình click chuột vào 1 ô trống ( ô trống anh nhé) ở Sheet Tổng hợp thì run Sub Nguoiban y rằng báo lỗi. Lỗi này thật phiền toái anh ạ. Ko lẽ ở Sheet Tổng hợp mình ko được chạm vào cái gì sao... mà thực tế ở Sheet này công ty em còn nhập liệu thêm vào ở các cột khác nữa. Anh xem có cách nào fix giúp em ko ạ.

bạn test file xem đúng ý chưa

 

[HieuCD]

Anh xem lại giúp em với ạ :
Có cái lỗi này kỳ quặc anh ạ. Lỗi này là do Sub Nguoiban. Mỗi khi em vô tình click chuột vào 1 ô trống ( ô trống anh nhé) ở Sheet Tổng hợp thì run Sub Nguoiban y rằng báo lỗi. Lỗi này thật phiền toái anh ạ. Ko lẽ ở Sheet Tổng hợp mình ko được chạm vào cái gì sao... mà thực tế ở Sheet này công ty em còn nhập liệu thêm vào ở các cột khác nữa. Anh xem có cách nào fix giúp em ko ạ.

do mình test không kỹ, nên chủ quan bớt một dòng lệnh cho gọn.Bạn thêm dòng lệnh màu đỏ

Public Sub Nguoiban1()
Dim Nban As String, tmp As String, i As Long, Arr, Darr
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Sheets(3)
Nban = .Range("A1")
.Range("A2:H20000").ClearContents
End With
Sheets(2).Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
For i = 2 To .Range("B65500").End(xlUp).Row
    If .Cells(i, 1) = "" Then .Cells(i, 1) = .Cells(i - 1, 1)
Next
.Range("A1:I" & .Range("B65500").End(xlUp).Row).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
        Key2:=.Range("B1"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1
[COLOR=#ff0000].Range("A1:I" & .Range("B65500").End(xlUp).Row).Select[/COLOR]
Selection.AutoFilter
.Range("$A$1:$I" & .Range("B65500").End(xlUp).Row).AutoFilter Field:=9, Criteria1:="<>" & Nban
.Rows("2:" & .Range("B65500").End(xlUp).Row).Delete Shift:=xlUp
Selection.AutoFilter
For i = 2 To .Range("B65500").End(xlUp).Row
    If .Cells(i, 1) = tmp Then
        .Cells(i, 1) = ""
    Else
        tmp = .Cells(i, 1)
    End If
Next
    .Range("A2:H" & .Range("B65000").End(xlUp).Row).Copy Sheets(3).Range("A2")
End With
Sheets(3).Select
ThisWorkbook.Sheets(Sheets.Count).Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[ohho84]

Cảm ơn anh nhiều lắm. E test kỹ. Chạy ngon anh ạ. Cảm ơn anh nhiều nhé.