Gửi các anh chị GPE thân mến !
Xin chỉ em đoạn code lấy giá trị từ hàm và xóa bỏ filter + validation cùng 1 lúc cho tất cả sheet trong worbook.
Hiện em đang làm thủ công cho 1 sheet rất mất thời gian vì có thể 1 file có đến cả trăm sheet.
Mong các anh chị hướng dẫn giúp
Em xin cám ơn trước.
Gửi các anh chị GPE thân mến !
Xin chỉ em đoạn code lấy giá trị từ hàm và xóa bỏ filter + validation cùng 1 lúc cho tất cả sheet trong worbook.
Hiện em đang làm thủ công cho 1 sheet rất mất thời gian vì có thể 1 file có đến cả trăm sheet.
Mong các anh chị hướng dẫn giúp
Em xin cám ơn trước.
Không làm một lúc. Vẫn làm lần lượt từng sheet nhưng dùng Macro nên sẽ nhanh thôi.
PHP:
Sub GPE()
On Error Resume Next
Application.ScreenUpdating = False
For Each sh In Sheets
sh.[IV1].AutoFilter
With sh.UsedRange
.Value = .Value
.Validation.Delete
End With
Next
Application.ScreenUpdating = True
End Sub
Gửi các anh chị GPE thân mến !
Xin chỉ em đoạn code lấy giá trị từ hàm và xóa bỏ filter + validation cùng 1 lúc cho tất cả sheet trong worbook.
Hiện em đang làm thủ công cho 1 sheet rất mất thời gian vì có thể 1 file có đến cả trăm sheet.
Mong các anh chị hướng dẫn giúp
Em xin cám ơn trước.
Sub Test()
Dim Sh As Worksheet, Area As Range
For Each Sh In ThisWorkbook.Worksheets
Sh.AutoFilterMode = False
With Sh.UsedRange
.Value = .Value
For Each Area In .SpecialCells(15).Areas
Area.Validation.Delete
Next Area
End With
Next Sh
End Sub
Sub Test()
Dim Sh As Worksheet, Area As Range
For Each Sh In ThisWorkbook.Worksheets
Sh.AutoFilterMode = False
With Sh.UsedRange
.Value = .Value
For Each Area In .SpecialCells(15).Areas
Area.Validation.Delete
Next Area
End With
Next Sh
End Sub
Cho em hỏi thêm là có cách nào lấy giá trị từ hàm và xóa bỏ filter + validation cùng 1 lúc cho tất cả worbook trong 1 folder mà không cần mở các worbook đó lên không ạ.
Rất mong các anh chị giúp đỡ.
Em xin cám ơn trước.
Cho em hỏi thêm là có cách nào lấy giá trị từ hàm và xóa bỏ filter + validation cùng 1 lúc cho tất cả worbook trong 1 folder mà không cần mở các worbook đó lên không ạ.
Rất mong các anh chị giúp đỡ.
Em xin cám ơn trước.
Em rất cám ơn về gọi ý của thầy, hiện em đang gặp vấn đề là làm sao không duyệt qua những sheet có tên là "Data", "List", "UserLog", "Size".
Em dùng đoạn code này
Sheet1 là "Data" và có khi là không phải là sheet1 nên đưa kết quả sai
Mã:
UCase(mySheet.CodeName) <> "SHEET1" And ....
Ý đồ của em là bỏ qua các sheet trên không cần phải gộp sheet với giá trị, không có validation của nhiều file vào 1 file.
Code như sau:
Mã:
Sub getvalue()
' GOP TAT CA CAC SHEET CUA NHIEU FILE CO CHUNG 1 FOLDER
' DIEU KIEN LA COT A CAC SHEET CUA FILE CAN GOP KHONG DUOC DE TRONG
On Error Resume Next
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'DUONG DAN DEN FILE
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
'If IsError(Application.Match(mySheet.Name, Array(mySheet.Name, "DATA"), 0)) Then
'If UCase(mySheet.CodeName) <> "SHEET1" And UCase(mySheet.CodeName) <> "SHEET3" _
'And UCase(mySheet.CodeName) <> "SHEET4" Then
mySheet.Activate
'End If
mySheet.AutoFilterMode = False
With mySheet.UsedRange
.Value = .Value
For Each Area In .SpecialCells(15).Areas
Area.Validation.Delete
Next Area
End With
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub
Rất mong các thầy cô và anh chị em giúp đỡ giùm.
Em xin cảm ơn trước.
Em rất cám ơn về gọi ý của thầy, hiện em đang gặp vấn đề là làm sao không duyệt qua những sheet có tên là "Data", "List", "UserLog", "Size".
Em dùng đoạn code này
Sheet1 là "Data" và có khi là không phải là sheet1 nên đưa kết quả sai
Mã:
UCase(mySheet.CodeName) <> "SHEET1" And ....
Ý đồ của em là bỏ qua các sheet trên không cần phải gộp sheet với giá trị, không có validation của nhiều file vào 1 file.
Code như sau:
Mã:
Sub getvalue()
' GOP TAT CA CAC SHEET CUA NHIEU FILE CO CHUNG 1 FOLDER
' DIEU KIEN LA COT A CAC SHEET CUA FILE CAN GOP KHONG DUOC DE TRONG
On Error Resume Next
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'DUONG DAN DEN FILE
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
'If IsError(Application.Match(mySheet.Name, Array(mySheet.Name, "DATA"), 0)) Then
'If UCase(mySheet.CodeName) <> "SHEET1" And UCase(mySheet.CodeName) <> "SHEET3" _
'And UCase(mySheet.CodeName) <> "SHEET4" Then
mySheet.Activate
'End If
mySheet.AutoFilterMode = False
With mySheet.UsedRange
.Value = .Value
For Each Area In .SpecialCells(15).Areas
Area.Validation.Delete
Next Area
End With
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub
Rất mong các thầy cô và anh chị em giúp đỡ giùm.
Em xin cảm ơn trước.
Sub getvalue()
On Error Resume Next
Dim myBook As Workbook, mySheet As Worksheet, i As Long
With Application.FileSearch
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
If UCase(mySheet.Name) <> "USERLOG" And _
UCase(mySheet.Name) <> "LIST" And _
UCase(mySheet.Name) <> "DATA" And _
UCase(mySheet.Name) <> "SIZE" Then
mySheet.AutoFilterMode = False
With mySheet.UsedRange
.Value = .Value
.SpecialCells(15).Delete
End With
With ThisWorkbook.Sheets(1)
mySheet.Range("A1").CurrentRegion.Copy .Range("C65536").End(xlUp).Offset(1, 0)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = mySheet.Name
End With
End If
Next mySheet
myBook.Close (True)
End If
Next i
End If
End With
'Basebook.SaveAs Application.GetSaveAsFilename
End Sub
Chưa hiểu lắm đoạn cuối Basebook.SaveAs Application.GetSaveAsFilename (mục đích để làm gì) ---> vì muốn SaveAs thành tên gì đó, ta cứ ghi vào thôi!
Cái này là vì em muốn mỗi khi chạy code xong nó sẽ cho 1 hộp thoại để lưu file vừa chạy vào 1 thư mục nào đó, mà thư mục đó nó không cố định, nên dùng cách củ chuối trên.
Wow! đúng nó đây rồi, cảm ơn thầy.
Có điều là em xin chỉnh theo như thầy đã hướng dẫn ở các bài trước từ đoạn sau:
Mã:
.SpecialCells(15).Delete
Vì đoạn code trên nó sẽ xóa bỏ luôn cell có validation chứ không phải bỏ validation.
Sửa thành:
Mã:
For Each Area In .SpecialCells(15).Areas
Area.Validation.Delete
Next Area
Cái này là vì em muốn mỗi khi chạy code xong nó sẽ cho 1 hộp thoại để lưu file vừa chạy vào 1 thư mục nào đó, mà thư mục đó nó không cố định, nên dùng cách củ chuối trên.
Sorry! Tôi nhầm chổ Validation
Bạn thay: .SpecialCells(15).Delete
thành .SpecialCells(15).Validation.Delete
là được!
--------
Còn vụ SaveAs tôi nghĩ có viết thêm code cũng hóa ra... thừa... Lý do là đằng nào khi bạn đóng file thì Excel cũng hỏi về việc lưu file thôi
