huonglien1901
GPE là ngôi nhà thứ 2 của tôi!!!
- Tham gia
- 17/4/16
- Bài viết
- 2,702
- Được thích
- 2,434
- Giới tính
- Nam
- Nghề nghiệp
- Nhân viên kỹ thuật in ấn
Em chào mọi người!
Em có vấn đề nhờ mọi người hỗ trợ.
Em muốn tách sheet DATA thành những thành những sheet chi tiết theo điều kiện tên.
Em cảm ơn mọi người nhiều!
Em có code này!(code này của Bác @Ba Tê ) em sửa lại nhưng nó chạy chậm và tách 2 sheet trùng nhau.
Trong đó sheet NV: Toàn, NV: Liêm lại trùng nhau. Nhờ mọi người hỗ trợ sửa code giúp em.
-yêu cầu 1: Trong này em có yêu cầu là nhờ: Các Sheet khi tách ra tự động căn chỉnh dòng và cột.
-yêu cầu 2: Tạo nút xem trước và in(in tất cả các sheet này( Trừ sheet DATA, sheet GPE)-những sheet in là sheet tên Nhân viên.
yêu cầu 3: làm thế nào đưa code vào để in 2 mặt.
code in 2 mặt;
Em có vấn đề nhờ mọi người hỗ trợ.
Em muốn tách sheet DATA thành những thành những sheet chi tiết theo điều kiện tên.
Em cảm ơn mọi người nhiều!
Em có code này!(code này của Bác @Ba Tê ) em sửa lại nhưng nó chạy chậm và tách 2 sheet trùng nhau.
Trong đó sheet NV: Toàn, NV: Liêm lại trùng nhau. Nhờ mọi người hỗ trợ sửa code giúp em.
-yêu cầu 1: Trong này em có yêu cầu là nhờ: Các Sheet khi tách ra tự động căn chỉnh dòng và cột.
-yêu cầu 2: Tạo nút xem trước và in(in tất cả các sheet này( Trừ sheet DATA, sheet GPE)-những sheet in là sheet tên Nhân viên.
yêu cầu 3: làm thế nào đưa code vào để in 2 mặt.
PHP:
Option Explicit
Public Sub s_Xoa()
Application.DisplayAlerts = False
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Data" And Ws.Name <> "GPE" Then Ws.Delete
Next Ws
Application.DisplayAlerts = True
End Sub
Sub s_TachSh()
Dim Dic As Object, ShName As String, sArr(), tArr(), dArr()
Dim I As Long, J As Long, K As Long, N As Long, R As Long, X As Long, Col As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 5).Value
R = UBound(sArr): Col = UBound(sArr, 2)
ReDim tArr(1 To R, 1 To 1)
For I = 1 To R
If Not Dic.Exists(sArr(I, 3)) Then
X = X + 1
Dic.Item(sArr(I, 3)) = X
tArr(X, 1) = sArr(I, 3)
End If
Next I
'-----------------------------------------
For N = 1 To X
ReDim dArr(1 To R, 1 To Col)
ShName = tArr(N, 1)
K = 0
For I = 1 To R
If sArr(I, 3) = ShName Then
K = K + 1
For J = 1 To Col
dArr(K, J) = sArr(I, J)
Next J
End If
Next I
Sheets("Data").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = ShName
Sheets(ShName).Range("A2").Resize(K, Col) = dArr
Sheets(ShName).Range("A2").Offset(K).Resize(10000, Col).Clear
Next N
End With
Set Dic = Nothing
End Sub
Public Sub s_Gpe()
Application.ScreenUpdating = False
s_Xoa
s_TachSh
Sheets("GPE").Activate
Application.ScreenUpdating = True
MsgBox "Coc, coc ... Tach Xong!", , "Xin Cam On!"
End Sub
PHP:
Option Explicit
Function pdPrinter(Optional ByVal PrinterName As String) As String
' This function will return the name of the given printer without any port indication,
' which is the syntax for printer names when using PrinterDuplex.
'
' The advantage of using this method is that you don't have to care about
' the language of the system, that you're running your macros on.
' Another advantage is that this function is using the PrinterDuplex object itself, to find
' the printer, thus you can be fairly sure, that the function will return a proper printer.
'
' If either no printer name is passed on to the function, or if the given printer cannot be found,
' the function will return the name of the active printer.
'
' If you want the active printer with the port indication in the language of the current system
' (i.e. your own language), you can just use the the standard 'Application.ActivePrinter' property.
' * ' Initialise
On Error Resume Next
' * ' Define variables
If PrinterName = vbNullString Then PrinterName = Application.ActivePrinter
Dim PDO As Object ' PrinterDuplex Object
Set PDO = CreateObject("PrinterDuplex.Class1")
Dim Counter As Long
Dim FoundPrinter As String
Dim Printers As Variant
Printers = PDO.ListPrinters ' Read all attached printers into an array
' * ' Request printer from user (if argument request that)
If PrinterName = "?" Then
PrinterName = Application.Dialogs(xlDialogPrinterSetup).Show
If UCase$(PrinterName) = "FALSE" Then GoTo EF:
End If
' * ' Search for the printer
For Counter = LBound(Printers) To UBound(Printers)
FoundPrinter = Left$(Printers(Counter), InStrRev(LCase$(Printers(Counter)), " on ") - 1)
If LCase$(FoundPrinter) = Left$(LCase$(PrinterName), Len(FoundPrinter)) Then
Exit For
Else
FoundPrinter = vbNullString
End If
Next
' * ' Default to the active printer if no printer is found
If FoundPrinter = vbNullString Then
FoundPrinter = Application.ActivePrinter
Counter = -3
Counter = InStrRev(FoundPrinter, " ")
If Counter > 2 Then
FoundPrinter = Left$(FoundPrinter, Counter - 1)
Counter = -3
Counter = InStrRev(FoundPrinter, " ")
If Counter > 2 Then
FoundPrinter = Left$(FoundPrinter, Counter - 1)
End If
End If
End If
EF: ' End of Function
pdPrinter = FoundPrinter
Set PDO = Nothing
If IsArray(Printers) Then Erase Printers
End Function
Lần chỉnh sửa cuối:
