VBS IMPLEMENTATION Worksheet Auto-_vbs by specified headers

Source: Internet
Author: User
Tags first row
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 &"

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.