Chia sẻ code tách dữ liệu theo điều kiện ra fie excel và nhờ chỉnh thêm tối ưu

[ltnhanhcm]

Xin chào anh, chị, em có 1 bộ code sưu tầm được có thể giúp mọi người tách dữ liệu theo điều kiện ra file excel tùy chỉnh được cột dữ liệu cần tách.
Em có xem trong diễn đàn thì nhiều người có chung 1 vấn đề cần được hỗ trợ nhiều là tách dữ liệu theo điều kiện ra nhiều excel riêng. Như là tách theo mã địa bàn, tách theo mã vật tư, tách theo mã nhân viên, mỗi 1 mã sẽ là 1 file khác nhau. Tuy nhiên cách mọi người code đang set cột theo cố định, là mã nhân viên cần tách ở cột C, thì code theo cột C, file người khác mã nhân viên ở cột D thì code theo cột D, dẫn đến khi thay đổi cột mã cần tách file phải điều chỉnh code.
Nay em có 1 bộ code có thể tách dữ liệu ra nhiều file excel không cố định cột, cách thực hiện như sau:
1. Quét vùng dữ liệu cần tách bao gồm cột tiêu đề, A6:Fxxx (hình 1).
2. Chọn ô tiêu đề muốn tách dữ liệu ra, ở đây em muốn tách dữ liệu theo khu vực thì chọn ô C6 (hình 2).
Bấm ok là sẽ tự tách ra từng file theo từng khu vực. Code em để bên dưới anh/chị nào cần có thể lấy dùng.

Tuy nhiên code sẽ không tách được dữ liệu nếu em quét vùng dữ liệu cần tách từ A5:Fxxx, do báo cáo em muốn tách theo form trên hình có 1 dòng tiêu đề phụ có merge ở trên. Vậy anh, chị nào có thể giúp em điều chỉnh code thêm 1 bước nữa, sau khi chọn ô tiêu đề muốn tách dữ liệu ra, chọn tiếp vùng cần copy dữ liệu (tùy chọn, như file là từ A5:Fxxx) và tách vùng dữ liệu này ra file khác được không. Em cảm ơn.

Update: diễn đàn không biết có ai làm được không nên tôi đã tự làm luôn rồi.

 

[Hoàng Tuấn 868]

Nên đưa code vào trong thẻ code, không nên để ngoài thế này.

 

[ltnhanhcm]

Nên đưa code vào trong thẻ code, không nên để ngoài thế này.

Em cũng tính vậy, mà không biết đưa vào thẻ code thế nào nhờ anh chỉ giúp.

 

[Hoàng Tuấn 868]

Em cũng tính vậy, mà ko biết đưa vào thẻ code thế nào nhờ anh chỉ giúp.

Không nên viết tắt
Tìm chỗ nào có hình như thế này: </>
Bấm vào đấy sẽ hiện ra một bảng như thế này:

Copy phần code rồi dán vào cửa sổ to nhất ở đó.

 

[Thóc Sama]

Xin chào anh, chị, em có 1 bộ code sưu tầm được có thể giúp mọi người tách dữ liệu theo điều kiện ra file excel tùy chỉnh được cột dữ liệu cần tách.
Em có xem trong diễn đàn thì nhiều người có chung 1 vấn đề cần được hỗ trợ nhiều là tách dữ liệu theo điều kiện ra nhiều excel riêng. Như là tách theo mã địa bàn, tách theo mã vật tư, tách theo mã nhân viên, mỗi 1 mã sẽ là 1 file khác nhau. Tuy nhiên cách mọi người code đang set cột theo cố định, là mã nhân viên cần tách ở cột C, thì code theo cột C, file người khác mã nhân viên ở cột D thì code theo cột D, dẫn đến khi thay đổi cột mã cần tách file phải điều chỉnh code.
Nay em có 1 bộ code có thể tách dữ liệu ra nhiều file excel không cố định cột, cách thực hiện như sau:
1. Quét vùng dữ liệu cần tách bao gồm cột tiêu đề, A6:Fxxx (hình 1).
2. Chọn ô tiêu đề muốn tách dữ liệu ra, ở đây em muốn tách dữ liệu theo khu vực thì chọn ô C6 (hình 2).
Bấm ok là sẽ tự tách ra từng file theo từng khu vực. Code em để bên dưới anh/chị nào cần có thể lấy dùng.

Tuy nhiên code sẽ không tách được dữ liệu nếu em quét vùng dữ liệu cần tách từ A5:Fxxx, do báo cáo em muốn tách theo form trên hình có 1 dòng tiêu đề phụ có merge ở trên. Vậy anh, chị nào có thể giúp em điều chỉnh code thêm 1 bước nữa, sau khi chọn ô tiêu đề muốn tách dữ liệu ra, chọn tiếp vùng cần copy dữ liệu (tùy chọn, như file là từ A5:Fxxx) và tách vùng dữ liệu này ra file khác được không. Em cảm ơn.

Sub Filter_To_New_Workbook()

Dim wb As Workbook
Dim ws As Worksheet
Dim Newwb As Workbook
Dim AcSh As Worksheet
Dim CriSh As Worksheet
Dim CriShRng As Range
Dim DataRng As Range
Dim DataRngCol As Long
Dim DataRngRow As Long
Dim CriCol As Range
Dim CriColAdd As String
Dim CriColAddStr As String
Dim CriColNo As Long
Dim SelCol As Long
Dim ZoomSetting As Long
Dim RRange As Range
Dim RCount As Long
Dim FName As String
Dim AwbPath As String
Dim xOutlook As String
Dim QtyCriSh As Long
Dim x As Range
Dim j As Long
Dim RowCount As Long

On Error GoTo Errorhandler

With Application
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set AcSh = wb.ActiveSheet
ZoomSetting = ActiveWindow.Zoom

AwbPath = Application.ActiveWorkbook.Path
xOutlook = "Content.Outlook"

If LCase(AwbPath) Like LCase("*" & xOutlook & "*") Or AwbPath = "" Then
MsgBox "Ban chua save file nay, hay save file truoc!"
With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.DisplayStatusBar = True
.EnableEvents = True
End With
Exit Sub
End If

Application.DisplayAlerts = False

For Each ws In wb.Worksheets
If ws.Name = "Dieu kien filter" Then
ws.Delete
End If
Next ws

Application.DisplayAlerts = True

Set DataRng = Selection
Set DataRng = Application.InputBox("Chon vung data chinh", "Chon vung", DataRng.Address, Type:=8)

RowCount = DataRng.Rows.Count

If RowCount > 1000000 Then
MsgBox "Vung ban chon qua lon, vui long chon dung vung can Filter!"
With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.DisplayStatusBar = True
.EnableEvents = True
End With
Exit Sub
End If

'Find the total of rows in range
RCount = 0

For Each RRange In DataRng.Rows
RCount = RCount + 1
Next RRange

'Find the first row in Range
DataRngRow = DataRng.Row

Set CriCol = Application.InputBox(prompt:="Chon cot chua dieu kien can lay tao file Excel moi", Type:=8)

With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.DisplayAlerts = False
.EnableEvents = False
End With

CriColAddStr = Split(CriCol.Address, "$")(1)
CriColAdd = "$" & CriColAddStr & "$" & DataRngRow & ":" & "$" & CriColAddStr & "$" & DataRngRow + RCount - 1
CriColNo = CriCol.Column

DataRngCol = DataRng.Column

SelCol = CriColNo - (DataRngCol - 1)

Set CriSh = Worksheets.Add
CriSh.Name = "Dieu kien filter"

With AcSh
.Activate
.Range(CriColAdd).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=CriSh.Range("a1"), Unique:=True
End With

CriSh.Activate
' Set RngFilter = Range([a2], Cells(Rows.Count, "a").End(xlUp)) ' range where the characters will be deleted
' sChars = "\/*?:[]" ' characters to delete
'
' For j = 1 To Len(sChars)
' RngFilter.Replace What:="~" & Mid(sChars, j, 1), Replacement:="-", LookAt:=xlPart, SearchOrder:=xlByRows, _
' MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Next j
'----------------------------------------------------------

QtyCriSh = 0
For Each x In CriSh.Range([a2], Cells(Rows.Count, "a").End(xlUp))
QtyCriSh = QtyCriSh + 1
Next x

If QtyCriSh > 50 Then
CriSh.Delete
MsgBox "Gioi han so luong dieu kien khong > 50, vui long chon xem lai!"
With Application
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
End With
Exit Sub
End If
'----------------------------------------------------------

For Each x In CriSh.Range([a2], Cells(Rows.Count, "a").End(xlUp))

With DataRng
.AutoFilter
.AutoFilter Field:=SelCol, Criteria1:=x.Value
.Copy
End With

Set Newwb = Workbooks.Add
On Error Resume Next

FName = wb.Path & "\" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(x.Value, "/", "-"), "\", "-"), "*", "-"), "?", "-"), ":", "-"), "<", "-"), ">", "-"), "|", "-"), Chr(34), "-")

With Newwb.Worksheets("Sheet1").Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)
.Range("a1").Select
End With

ActiveWindow.Zoom = ZoomSetting
With Newwb
.SaveAs Filename:=FName, FileFormat:=51
.Close savechanges:=False
End With

Next x

AcSh.AutoFilterMode = False

Application.DisplayAlerts = False

CriSh.Delete

AcSh.Activate

MsgBox "Nhanlt: Done, vui long kiem tra thu muc chua file nay!"

With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.DisplayStatusBar = True
.EnableEvents = True
End With

Errorhandler:
With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.DisplayStatusBar = True
.EnableEvents = True
End With

Exit Sub

End Sub

Vụ này trên GPE chỉ có một bác giúp được bạn thôi, nếu chưa biết bác nào thì tham khảo hình dưới xem.

 

[ltnhanhcm]

Vụ này trên GPE chỉ có một bác giúp được bạn thôi, nếu chưa biết bác nào thì tham khảo hình dưới xem.
View attachment 292231

Chắc là anh nói tôi đúng không, bởi vì tôi đã tự làm được rồi, code chạy ngon hơn trước nữa khà khà quá đã. Bây giờ tiêu đề có 100 merge hay nằm ở dòng 100 cũng copy ra file mới được.
Bộ code của tôi hiện giờ có thể giải quyết 100% tất cả các thread yêu cầu tách file theo điều kiện và không cần cố định cột filter.
Diễn đàn này giờ có ích thật, cứ tôi không biết làm gì cứ post lên là tự làm được hết, quá hay.

 

[VetMini]

...
Diễn đàn này giờ có ích thật, cứ tôi không biết làm gì cứ post lên là tự làm được hết, quá hay.

Giò mới biết rằng nó "có ích" à?
Làm vài lần nữa thì chữa được cái bệnh lười động não, động ngón tay gõ phím.

Ai cũng biết bạn có thể tự làm được nhưng phải cái tật lười biếng và ỷ lại, muốn lợi dụng người khác ra công ra sức cho mình.

 

[Thóc Sama]

Update: diễn đàn không biết có ai làm được không nên tôi đã tự làm luôn rồi.

Chắc nay BQT đang offline, tôi nghĩ thế!
Nhiều người ở đây hiểu ý tôi muốn nói đến điều gì, nhưng chắc chắn bạn không phải một trong số đó.

 

[ltnhanhcm]

Giò mới biết rằng nó "có ích" à?
Làm vài lần nữa thì chữa được cái bệnh lười động não, động ngón tay gõ phím.

Ai cũng biết bạn có thể tự làm được nhưng phải cái tật lười biếng và ỷ lại, muốn lợi dụng người khác ra công ra sức cho mình.

Cho hỏi xíu sao bạn biết mình tự làm được trước khi mình báo đã làm rồi hay vậy, mình hỏi thiệt đó

 

[SA_DQ]

Cho hỏi xíu sao bạn biết mình tự làm được trước khi mình báo đã làm rồi hay vậy, mình hỏi thiệt đó

Mình trả lời giúp bác í cho nha:
Nhồm vô điểm tương tác của bạn thì ai trong cộng đồng không biết cũng hơi bị dỡ cơ đấy!

Giang san có thể đổi, cơ nhưng mà bản tính thì khó dời

 

[ltnhanhcm]

Mình trả lời giúp bác í cho nha:
Nhồm vô điểm tương tác của bạn thì ai trong cộng đồng không biết cũng hơi bị dỡ cơ đấy!

Hình như em với bác không hợp nhau, bác cứ trả lời tréo ngoe em không à. Bác @VetMini đang nói là biết em làm được thì em mới hỏi là sao biết được trước khi em làm bài đó, bác đưa điểm tương tác có khác nào nói em không làm được trong khi bài đó em làm được rồi. Điểm tương tác đấy cũng nhờ công của bác đó.

 

[Thóc Sama]

Mình trả lời giúp bác í cho nha:
Nhồm vô điểm tương tác của bạn thì ai trong cộng đồng không biết cũng hơi bị dỡ cơ đấy!

Em có fan cứng rồi bác ạ!
Hỏng biết có mỏi tay không?!

 

[Thóc Sama]

Em có fan cứng rồi bác ạ!
Hỏng biết có mỏi tay không?!

Sự học mà cũng kiên trì thế này có khi đã rất giỏi rồi.
Hỏng thật!

 

[VetMini]

Cho hỏi xíu sao bạn biết mình tự làm được trước khi mình báo đã làm rồi hay vậy, mình hỏi thiệt đó

Tôi cũng trả lời thiệt: tôi có nghề đoán trình độ người. Nhưng không chia sẻ đâu. Có hai lý do:

1. Chủ quan (do tự tôi): Bạn biết cách tôi nhìn rồi về sau bạn tránh đi, mất công tôi lại phải mò.

2. Khách quan (do tự bạn): Bạn mở đầu đề bài bằng 2 từ "chia sẻ". Nhưng cuối cùng, tự giải xong rồi thì chỉ thấy bạn móc đầu này, ngoéo đầu nọ chứ cái thiện chí "chia sẻ" ấy nó biến đâu mất. Nói huênh hoang nhưng hành động đầu voi đuôi chuột.

 

[ltnhanhcm]

Tôi cũng trả lời thiệt: tôi có nghề đoán trình độ người. Nhưng không chia sẻ đâu. Có hai lý do:

1. Chủ quan (do tự tôi): Bạn biết cách tôi nhìn rồi về sau bạn tránh đi, mất công tôi lại phải mò.

2. Khách quan (do tự bạn): Bạn mở đầu đề bài bằng 2 từ "chia sẻ". Nhưng cuối cùng, tự giải xong rồi thì chỉ thấy bạn móc đầu này, ngoéo đầu nọ chứ cái thiện chí "chia sẻ" ấy nó biến đâu mất. Nói huênh hoang nhưng hành động đầu voi đuôi chuột.

Vốn dĩ ban đầu mình muốn chia sẻ nên post lên, rốt cuộc không ai cần mà có thêm mấy cái dislike mà không ai đề cập đến nên mình thu hồi lại thôi, mọi người không cần thì mình không để nữa.
Còn mình post bài hỏi là cả tuần mình làm t2 đến t6, về tối cũng trễ không có thời gian tìm hiểu để giải cái bài mình đang cần. Tranh thủ thứ 7, cn mới đăng bài hỏi, vì ở đây mọi người cũng giỏi code với code nhiều nên nhận ra vấn đề để giải quyết nhanh nên mình mới post bài nhờ hỗ trợ.
Nhưng có lẽ những người có khả năng lập trình VBA còn hoạt động trong group này đếm trên đầu ngón tay. Người thì hay bắt làm cái này cái kia, người thì inbox riêng để báo phí code. Đặc biệt có người còn thích thả haha bài post với đi khịa hơn cả.
Cho nên mình có chút phản đòn chứ không tự nhiên mình làm vậy.

 

[Mr.hieudoanxd]

Người thì hay bắt làm cái này cái kia, người thì inbox riêng để báo phí code. Đặc biệt có người còn thích thả haha bài post với đi khịa hơn cả.

E thì chả là gì để lên tiếng dạy đời ai cả. Có điều e chia sẻ góc nhìn của e như thế này!. Trong diễn đàn này hay bất cứ nơi nào khác không có bất cứ ai có nghĩa vụ phải trả lời, giải thích, hướng dẫn ai cả trừ khi họ muốn(*). Vậy nên nếu có người giỏi giúp đỡ thì là điều tốt, còn với những câu trả lời không vừa ý mình thì vui vẻ cho qua bởi vì(*). Như thế này b hoàn toàn trở thành tâm điểm (theo e thấy là không đẹp đẽ trong mắt mọi người)

 

[Maika8008]

Sự học mà cũng kiên trì thế này có khi đã rất giỏi rồi.
Hỏng thật!

Đi bấm dislike tất cả bài viết của 1 người gọi là hành động gì nhỉ?

Tôi nghĩ BQT cần lên tiếng và có động thái chấn chỉnh việc này!

 

[ltnhanhcm]

E thì chả là gì để lên tiếng dạy đời ai cả. Có điều e chia sẻ góc nhìn của e như thế này!. Trong diễn đàn này hay bất cứ nơi nào khác không có bất cứ ai có nghĩa vụ phải trả lời, giải thích, hướng dẫn ai cả trừ khi họ muốn(*). Vậy nên nếu có người giỏi giúp đỡ thì là điều tốt, còn với những câu trả lời không vừa ý mình thì vui vẻ cho qua bởi vì(*). Như thế này b hoàn toàn trở thành tâm điểm (theo e thấy là không đẹp đẽ trong mắt mọi người)

Thì mình đâu có bắt ai phải trả lời. Tuy nhiên ở thư mục giải trí hay diễn đàn chuyên về giải trí trò chuyện qua lại thì có thể khịa nhau nhưng ở đây không giúp được gì thì hãy im lặng.
Mình không thích những hành động không giúp được mà hay phán xét. Rồi khịa người khác, mục đích mình post bài không phải để đôi co mà cứ gặp thì mình sẽ phản ứng thôi.

 

[Thóc Sama]

Đi bấm dislike tất cả bài viết của 1 người gọi là hành động gì nhỉ?

Tôi nghĩ BQT cần lên tiếng và có động thái chấn chỉnh việc này!

Họ không thích thì dis thôi bác.
Xử lý thì cũng khác gì cắt cái ngọn và còn cái gốc đâu (mà cái gốc không bao giờ cắt được”.
Vài phút sau lại mọc lên một “thành viên” có khi độ ngáo ngơ còn tăng lên gấp bội.

 

[ltnhanhcm]

Đi bấm dislike tất cả bài viết của 1 người gọi là hành động gì nhỉ?

Tôi nghĩ BQT cần lên tiếng và có động thái chấn chỉnh việc này!

BQT cần lên tiếng để các thành viên không nên nói xàm xí ở trong mục lập trình này, đồng thời ra nội quy và rà soát xóa bình luận các thành viên đi lộn từ mục thư giãn qua đây.