In our actual work, we often encounter the separation of worksheets by a header field, our general practice is to first sort by the specified header and then segmented copy paste out, not only trouble is also easy to get wrong.
The following VBS script is the implementation worksheet that automatically functions by the specified header (selected by the user). Friends you need as long as the worksheet you want to work on is dragged and dropped onto the script file, you can easily implement the worksheet table (temporarily only for XP systems):
Copy Code code as follows:
' Drag sheet to VBS script implementation Auto-table by specified header
On Error Resume Next
If wscript.arguments (0) = "" Then Wscript.Quit
Dim objexcel, Excelfile, MaxRows, MaxColumns, Shcount
Excelfile = wscript.arguments (0)
If LCase (excelfile,4) <> ". xls" and LCase (right (excelfile,4)) <> ". xls" Then Wscript.Quit
Set Objexcel = CreateObject ("Excel.Application")
Objexcel.visible = False
ObjExcel.Workbooks.Open Excelfile
' Get the total number of initial sheet of the worksheet
Shcount = ObjExcel.Sheets.Count
' Get the number of active rows in the worksheet
MaxRows = ObjExcel.ActiveSheet.UsedRange.Rows.Count
MaxColumns = ObjExcel.ActiveSheet.UsedRange.Columns.Count
' Get the first row header list of the worksheet
Dim Strgroup
For i = 1 to MaxColumns
Strgroup = Strgroup & "[" & I & "]" & VbTab & objExcel.Cells (1, i). Value & VbCrLf
Next
' User-specified table header and input legal judgment
Dim Num, Hardvalue
Num = InputBox ("Please enter the ordinal number of the table header" & VbCrLf & Strgroup)
If Num <> "" Then
num = Int (num)
If num > 0 and num <= maxcolumns Then
Hardvalue = objExcel.Cells (1, Num). Value
Else
Objexcel.quit
Set Objexcel = Nothing
Wscript.Quit
End If
Else
Objexcel.quit
Set Objexcel = Nothing
Wscript.Quit
End If
' Get the header value and the number of minutes of the table
Dim valuegroup:j = 0
Dim A (): ReDim A (10000)
For i = 2 to MaxRows
str = objExcel.Cells (i, Num). Value
If InStr (valuegroup, str) = 0 Then
A (j) = str
Valuegroup = valuegroup & str & ","
j = j + 1
End If
Next
ReDim Preserve A (j-1)
' Create a new sheet and name it with the specified table header value
For i = 0 to UBound (a)
If i + 2 > Shcount Then objExcel.Sheets.Add, objexcel.sheets ("sheet" & i + 1), 1,-4167
Next
For i = 0 to UBound (a)
Objexcel.sheets ("Sheet" & i + 2). Name = Hardvalue & "_" & A (i)
Next
' Table-writing data
For i = 1 to MaxRows
For j = 1 to MaxColumns
Objexcel.sheets (1). Select
str = objexcel.cells (i,j). Value
If i = 1 Then
For k = 0 to UBound (a)
Objexcel.sheets (Hardvalue & "_" & A (k)). Select
objExcel.Cells (I,J). Value = str
objExcel.Cells (1, MaxColumns + 1). Value = 1
Next
Else
Objexcel.sheets (Hardvalue & "_" & objExcel.Cells (I,num). Value). Select
If j = 1 Then x = objexcel.cells (1, MaxColumns + 1). Value + 1
objExcel.Cells (x, J). Value = str
If j = MaxColumns Then objexcel.cells (1, MaxColumns + 1). Value = X
End If
Next
Next
For i = 0 to UBound (a)
Objexcel.sheets (Hardvalue & "_" & A (i)). Select
objExcel.Cells (1, MaxColumns + 1). Value = ""
Next
ObjExcel.ActiveWorkbook.Save
Objexcel.quit
Set Objexcel = Nothing
WScript.Echo "Hint: complete the table operation for & Excelfile &"
