Network Security Internet Technology Development Database Servers Mobile Phone Android Software Apple Software Computer Software News IT Information

In addition to Weibo, there is also WeChat

Please pay attention

WeChat public account

Shulou

How to realize the automatic sorting of worksheets according to the specified header by VBS

2025-03-04 Update From: SLTechnology News&Howtos shulou NAV: SLTechnology News&Howtos > Development >

Share

Shulou(Shulou.com)06/03 Report--

This article mainly introduces VBS how to achieve automatic sub-table according to the specified header of the worksheet, the article introduces in great detail, has a certain reference value, interested friends must read it!

In our actual work, we often encounter the situation that the worksheet is separated by a certain header field. our general practice is to sort by the specified header and then copy and paste it in segments, which is not only troublesome but also easy to make a mistake.

The following VBS script implements the function of automatically dividing the worksheet according to the specified header (selected by the user). For those who need it, you can easily implement the sub-table of the worksheet by dragging and dropping the worksheet to the script file (for the time being, it is only applicable to xp systems):

The code is as follows:

'drag the worksheet to the VBS script to automatically divide the table according to the 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 (Right (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 initial sheet of the worksheet

SHCount = objExcel.Sheets.Count

'get the valid rows and rows of the worksheet

MaxRows = objExcel.ActiveSheet.UsedRange.Rows.Count

MaxColumns = objExcel.ActiveSheet.UsedRange.Columns.Count

'get the list of headers in the first row of the worksheet

Dim StrGroup

For I = 1 To MaxColumns

StrGroup = StrGroup & "[" & I & "] & vbTab & objExcel.Cells (1, I). Value & vbCrLf

Next

'user-specified sub-table header and input legal judgment

Dim Num, HardValue

Num = InputBox ("Please enter the serial number of the subtable header" & vbCrLf & StrGroup)

If Num "" Then

Num = Int (Num)

If Num > 0 And Num SHCount Then objExcel.Sheets.Add, objExcel.Sheets ("sheet" & I + 1), 1mai muri 4167

Next

For I = 0 To UBound (a)

ObjExcel.Sheets ("sheet" & I + 2). Name = HardValue & "_" & a (I)

Next

'write data by table

For I = 1 To MaxRows

For j = 1 To MaxColumns

ObjExcel.sheets (1). Select

Str = objExcel.Cells (iMagnej). Value

If I = 1 Then

For k = 0 To UBound (a)

ObjExcel.sheets (HardValue & "_" & a (k)) .Select

ObjExcel.Cells (iMagazine j). Value = str

ObjExcel.Cells (1, MaxColumns + 1). Value = 1

Next

Else

ObjExcel.sheets (HardValue & "_" & objExcel.Cells (iMagneNum) .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: the split table operation for" & ExcelFile & "is complete"

The above is all the contents of the article "how to automatically divide the worksheet according to the specified header by VBS". Thank you for your reading! Hope to share the content to help you, more related knowledge, welcome to follow the industry information channel!

Welcome to subscribe "Shulou Technology Information " to get latest news, interesting things and hot topics in the IT industry, and controls the hottest and latest Internet news, technology news and IT industry trends.

Views: 0

*The comments in the above article only represent the author's personal views and do not represent the views and positions of this website. If you have more insights, please feel free to contribute and share.

Share To

Development

Wechat

© 2024 shulou.com SLNews company. All rights reserved.

12
Report