Tách sheet theo điều kiện cột

[Hai Lúa Miền Tây]

Gửi Thầy cô và anh chị GPE thân mến.

Xin giúp em code tách cột dữ liệu ra từng sheet riêng biệt như sau:

-Phần tô màu xanh copy qua sheet mới giữ nguyên.
-Phần tô màu vàng là điều kiện để tách sheet.

Chi tiết em có diễn tả trong file đính kèm.

Em xin cám ơn trước.

 

[ThuNghi]

Gửi Thầy cô và anh chị GPE thân mến.

Xin giúp em code tách cột dữ liệu ra từng sheet riêng biệt như sau:

-Phần tô màu xanh copy qua sheet mới giữ nguyên.
-Phần tô màu vàng là điều kiện để tách sheet.

Chi tiết em có diễn tả trong file đính kèm.

Em xin cám ơn trước.

Mình gợi ý thế này có OK.
1/ Đếm bao nhiêu chữ color (n), cột đầu tiên là cột thứ mấy.
2/ Copy ra n sheet.
3/ Duyệt qua từng sh, đặt tên và xóa các cột không cần.

 

[ndu96081631]

Bạn để nguyên sheet ấy, chèn thêm 1 sheet nữa rồi dùng ComboBox hoặc Validation chọn Sheet (theo màu) có phải gọn hơn không? Sao phải chèn nhiều sheet thế?

 

[Hai Lúa Miền Tây]

Bạn để nguyên sheet ấy, chèn thêm 1 sheet nữa rồi dùng ComboBox hoặc Validation chọn Sheet (theo màu) có phải gọn hơn không? Sao phải chèn nhiều sheet thế?

Vấn đề của em là ở chổ để chung vào 1 sheet để phối màu cho sản phẩm và kiểm tra định mức cho dể. Sau khi kiểm tra mọi thứ OK em sẽ tách ra mỗi một màu là 1 sheet riêng biệt để nhập nó vào chương trình riêng để kết hợp vật tư.

To anh ThuNghi: gợi ý của anh rất hay, em sẽ suy nghĩ theo hướng của anh, hỏng biết có suy nghĩ ra không đây.

 

[ThuNghi]

Vấn đề của em là ở chổ để chung vào 1 sheet để phối màu cho sản phẩm và kiểm tra định mức cho dể. Sau khi kiểm tra mọi thứ OK em sẽ tách ra mỗi một màu là 1 sheet riêng biệt để nhập nó vào chương trình riêng để kết hợp vật tư.

To anh ThuNghi: gợi ý của anh rất hay, em sẽ suy nghĩ theo hướng của anh, hỏng biết có suy nghĩ ra không đây.

Em làm thử theo code sau thử. Nhớ test lại

Sub CopySh()
Dim endr As Long, soSh As Long
Dim shName As String
Dim WF As WorksheetFunction
Set WF = WorksheetFunction
With Application
  .ScreenUpdating = False
End With
With Sheets("Color")
  endr = .Cells(65000, 1).End(xlUp).Row
  soSh = WF.CountIf(.Range("F3:X3"), "Color")
End With
For i = 1 To soSh
  Sheets("COLOR").Select
  Sheets("COLOR").Copy Before:=Sheets(1)
  shName = Cells(2, i + 5)
  ActiveSheet.Name = shName
  Select Case i
  Case 1
      Range(Cells(2, i + 6), Cells(endr, 5 + soSh)).Delete Shift:=xlToLeft
  Case sosh
    Range(Cells(2, 6), Cells(endr, i + 4)).Delete Shift:=xlToLeft
  Case Else
    Range(Cells(2, i + 6), Cells(endr, 5 + soSh)).Delete Shift:=xlToLeft
    Range(Cells(2, 6), Cells(endr, i + 4)).Delete Shift:=xlToLeft
  End Select
Next

With Application
  .ScreenUpdating = True
End With


End Sub

 

[rollover79]

Gửi Thầy cô và anh chị GPE thân mến.

Xin giúp em code tách cột dữ liệu ra từng sheet riêng biệt như sau:

-Phần tô màu xanh copy qua sheet mới giữ nguyên.
-Phần tô màu vàng là điều kiện để tách sheet.

Chi tiết em có diễn tả trong file đính kèm.

Em xin cám ơn trước.

Bạn thử đoạn code này xem, về thuật toán code chưa tối ưu lắm bạn cải tiến thêm. Trong file tôi dùng 1 Name là rngSplit. Bạn hoàn toàn có thể dùng code để xác định được vùng này thay vì dùng Name(Dùng Name hơi cứng...)

 

[Hai Lúa Miền Tây]

Cả 2 cách đều hay.

Nhưng hiện giờ em đang bị vướng ở chổ là nếu xóa cột thì những công thức phía đằng sau sẽ bị lỗi tham chiếu (#REF!)

Em khắc phục bằng cách thay thế dấu "=" của hàm = dấu "^^" trước khi thực hiện lệnh copy sheet. Nhưng nó chỉ đúng cho những vùng tham chiếu phía trước. Còn phía sau thì bị sai. (Vùng em tô màu xanh)

Code như sau:

Sub ChuyenCT()
On Error Resume Next
   Application.ScreenUpdating = False
    With Sheets("COLOR").UsedRange
        .Replace "=", "^^"
    End With
      Application.ScreenUpdating = True
End Sub
Sub DoiCT()
On Error Resume Next
 Application.ScreenUpdating = False
     Dim Ws As Worksheet
    For Each Ws In ThisWorkbook.Worksheets
    With Ws.UsedRange
        .Replace "^^", "="
    End With
 
   Next
  Application.ScreenUpdating = True
End Sub

Mong anh giúp giùm.

 

[huuthang_bd]

Cả 2 cách đều hay.

Nhưng hiện giờ em đang bị vướng ở chổ là nếu xóa cột thì những công thức phía đằng sau sẽ bị lỗi tham chiếu (#REF!)

Em khắc phục bằng cách thay thế dấu "=" của hàm = dấu "^^" trước khi thực hiện lệnh copy sheet. Nhưng nó chỉ đúng cho những vùng tham chiếu phía trước. Còn phía sau thì bị sai. (Vùng em tô màu xanh)

Code như sau:

Sub ChuyenCT()
On Error Resume Next
   Application.ScreenUpdating = False
    With Sheets("COLOR").UsedRange
        .Replace "=", "^^"
    End With
      Application.ScreenUpdating = True
End Sub
Sub DoiCT()
On Error Resume Next
 Application.ScreenUpdating = False
     Dim Ws As Worksheet
    For Each Ws In ThisWorkbook.Worksheets
    With Ws.UsedRange
        .Replace "^^", "="
    End With
 
   Next
  Application.ScreenUpdating = True
End Sub

Mong anh giúp giùm.

Bạn thay dấu "=" thành dấu "^^" trước khi xóa cột đâu có được. Vì sau khi bạn xóa cột, địa chỉ các ô đã thay đổi hết mà công thức thì địa chỉ ô vẫn như cũ. Một số công thức đúng là do công thức đó tham chiếu đến những ô ở trước cột bị xóa vì vậy địa chỉ của nó không bị ảnh hưởng. Còn những công thức có tham chiếu đến ô sau cột bị xóa dù có ra kết quả thì kết quả cũng không đúng như bạn mong muốn. Bạn kiểm tra lại.

Tôi làm như thế này:

Sub GPE()
Dim Shs As Byte, Tam As Worksheet
Application.ScreenUpdating = False
Sheets("COLOR").Copy Before:=Sheets(1)
ActiveSheet.Name = UCase("cost " & [D2].Value & " - (" & [F3] & ")")
Set Tam = ActiveSheet
Shs = WorksheetFunction.CountIf(Sheets("COLOR").Range("F2:X2"), "Color")
Tam.[G:G].Resize(, Shs - 1).Delete
For i = 2 To Shs
Tam.Copy Before:=Sheets(1)
ActiveSheet.Columns(6).Value = Sheets("COLOR").Columns(5 + i).Value
ActiveSheet.Name = UCase("cost " & [D2].Value & " - (" & [F3] & ")")
Next
Application.ScreenUpdating = True
End Sub

Bạn xem thêm file.

 

[ndu96081631]

Cả 2 cách đều hay.

Nhưng hiện giờ em đang bị vướng ở chổ là nếu xóa cột thì những công thức phía đằng sau sẽ bị lỗi tham chiếu (#REF!)
Mong anh giúp giùm.

Thay vì copy ra các sheet rồi xóa, bạn làm cách sau:
- Ẩn toàn bộ vùng COLOR (ẩn cột)
- Vòng lập quét qua vùng COLOR này và cho hiện ra từng cột
- Copy Visible cell rồi paste sang sheet mới
Một vòng lập duy nhất là đủ
---------
Tôi đưa lên 1 file Test cho bạn thí nghiệm nhé
= Chay code
- InputBox 1 hiện ra cho bạn chọn vùng dử liệu ---> Thực tế trong file bạn là vùng A2:U27
- InputBox 2 hiện ra cho bạn chọn vùng điều kiện ---> Thực tế trong file bạn là vùng F2:K2
- OK 1 nhát là ra

 

[huuthang_bd]

Thay vì copy ra các sheet rồi xóa, bạn làm cách sau:
- Ẩn toàn bộ vùng COLOR (ẩn cột)
- Vòng lập quét qua vùng COLOR này và cho hiện ra từng cột
- Copy Visible cell rồi paste sang sheet mới
Một vòng lập duy nhất là đủ
---------
Tôi đưa lên 1 file Test cho bạn thí nghiệm nhé
= Chay code
- InputBox 1 hiện ra cho bạn chọn vùng dử liệu ---> Thực tế trong file bạn là vùng A2:U27
- InputBox 2 hiện ra cho bạn chọn vùng điều kiện ---> Thực tế trong file bạn là vùng F2:K2
- OK 1 nhát là ra

Nếu dữ liệu có công thức thì công thức trong các sheet mới sẽ tham chiếu sai.