giúp đỡ trích lọc và quản lý dữ liệu

[giaosy]

Nhờ các bác giải quyết giúp vấn đề này:
tôi muốn cập nhật các thông tin về loại hàng từ sheet data vào các sheet tương ứng (gà vào gà, thỏ vào thỏ).
Đối với những mặt hàng mới, nếu chưa có sheet tương ứng thì excel tự tạo ra một sheet mới với tên tương ứng để cập nhật
Tại các sheet dữ liệu mới không ghi đè mà ghi xuống dòng dưới.
Cảm ơn các bác

 

[ChanhTQ@]

Phải chi có thêm file E2003 thì tiện, nhỉ?

&&&%$r

 

[giaosy]

xin lỗi các bác, có ngay đây

 

[ChanhTQ@]

Xin đề xuất xài mã tên thay vì tên gọi tiếng Việt

Vì trong VBA không hỗ trợ tiếng Việt, nên bạn muốn gán tên tiếng Việt tự động vô file mới tạo là chuyện không đơn giản;

Mình xin đề xuất với bạn:

* Tại Sheets("DuLieu) bạn thêm trường [MaHH]
* Và mọi vấn đề liên quan đến mã này; Ví dụ

A|B|C|D
MaHg | Ten | SoLg | DGia
Ga01|Gà|10|300
Tho1|Thỏ|12|450
Ga01|Gà|40|230
Meo1|Mèo|58|345

 

[giaosy]

tôi đã mã hóa lại rồi nhưng không được. hic

 

[ndu96081631]

tôi đã mã hóa lại rồi nhưng không được. hic

Cái này dể mà...
Bạn tạo 1 UDF kiểm tra sự tồn tại của sheet:

Public Function SheetExist(WorkSheetName As String) As Boolean
    Dim Ws As Worksheet
    On Error Resume Next
    Set Ws = Sheets(WorkSheetName)
    On Error GoTo 0
    SheetExist = Not Ws Is Nothing
End Function

Cuối cùng là code trích lọc:

Sub Trich()
  Dim Clls As Range
  For Each Clls In Range(Sheets("Data").[A2], Sheets("Data").[A65536].End(xlUp))
    If SheetExist(Clls.Value) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Clls
    End If
    Sheets(Clls.Value).Range("A1:C1").Value = Sheets("Data").Range("A1:C1").Value
    Sheets(Clls.Value).Range("A65536").End(xlUp).Offset(1).Resize(, 3).Value = Clls.Resize(, 3).Value
  Next Clls
End Sub

Tên sheet tiếng gì cũng được tuốt
Xem file

 

[giaosy]

Tôi mầy mò mất mấy ngày không xong. Hic
hay quá, thanks bác ndu96081631
bác có ở Hà nội thì lúc nào gặp nhau cafe - Beer - or something

 

[ndu96081631]

Ái chà... đúng là mình ngu thật... Lý ra cái Function này

Public Function SheetExist(WorkSheetName As String) As Boolean
    Dim Ws As Worksheet
    On Error Resume Next
    Set Ws = Sheets(WorkSheetName)
    On Error GoTo 0
    SheetExist = Not Ws Is Nothing
End Function

Có thể rút gọn thành:

Public Function SheetExist(WorkSheetName As String) As Boolean
    On Error Resume Next
    SheetExist = Not Sheets(WorkSheetName) Is Nothing
End Function

Viết chi cho... lằng nhằng...
Bạn cập nhật lại nhé

 

[minhlev]

...

Cuối cùng là code trích lọc:
[php]
Sub Trich()
  Dim Clls As Range
  For Each Clls In Range(Sheets("Data").[A2], Sheets("Data").[A65536].End(xlUp))
    If SheetExist(Clls.Value) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Clls
    End If
    Sheets(Clls.Value).Range("A1:C1").Value = Sheets("Data").Range("A1:C1").Value
    Sheets(Clls.Value).Range("A65536").End(xlUp).Offset(1).Resize(, 3).Value = Clls.Resize(, 3).Value
  Next Clls
End Sub

...

To bác ndu96081631: Với đoạn code trên của bác, nếu số dòng trong cột A rất lớn mà số mặt hàng lại không nhiều lắm thì sẽ chạy hơi lâu. Nếu có thể thì nhờ bác giúp viết nốt đoạn code lọc dữ liệu trong cột A thuộc Sheets("Data") thành duy nhất, sau đó mới tìm xem có mặt hàng nào mới để tạo sheet theo tên mặt hàng đó được không???.

 

[ndu96081631]

To bác ndu96081631: Với đoạn code trên của bác, nếu số dòng trong cột A rất lớn mà số mặt hàng lại không nhiều lắm thì sẽ chạy hơi lâu. Nếu có thể thì nhờ bác giúp viết nốt đoạn code lọc dữ liệu trong cột A thuộc Sheets("Data") thành duy nhất, sau đó mới tìm xem có mặt hàng nào mới để tạo sheet theo tên mặt hàng đó được không???.

Àh... cái đó tôi có nghĩ qua, nhưng vì chưa biết ý tác giả trích lọc thế nào nên chưa dám... thêm
Thật ra cũng dể thôi... AutoFilter theo từng mặt hàng, xong copy rồi paste qua các sheet
Như kiểu này đây:

Sub Trich()
  Dim Clls As Range, Sh As Worksheet
  Set Sh = ActiveSheet
  Application.ScreenUpdating = False
  With Sheets("Data").Range("A1").CurrentRegion
    .Resize(, 1).AdvancedFilter 2, , Sheets("Data").[IV1], True
    For Each Clls In Range(Sheets("Data").[IV2], Sheets("Data").[IV65536].End(xlUp))
      If SheetExist(Clls.Value) = False Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Clls
      End If
      Sheets(Clls.Value).Range("A1").CurrentRegion.ClearContents
      .AutoFilter 1, Clls
      .SpecialCells(12).Copy
      Sheets(Clls.Value).Range("A1").PasteSpecial 3
    Next Clls
    .AutoFilter
  End With
  Sheets("Data").Range("IV1").CurrentRegion.Clear
  Sh.Activate
  Application.ScreenUpdating = True
End Sub

 

[giaosy]

Xin hỏi thêm bác ndu96081631 và các bác trong diễn dàn nếu sau khi lọc (autofill) xong, không copy vào các sheet nữa, mà copy mỗi mã hàng vào một workbook mới, tên của workbook này là thời gian tạo file đó hoặc là mã hàng (như đặt cho sheet) rồi lưu vào một forder định sẵn thì có được không.
Thanks