'Drag the worksheet to the VBS script to automatically divide the table according to the specified table header
On Error Resume Next
If (0) = "" Then
Dim objExcel, ExcelFile, MaxRows, MaxColumns, SHCount
ExcelFile = (0)
If LCase(Right(ExcelFile,4)) <> ".xls" And LCase(Right(ExcelFile,4)) <> ".xls" Then
Set objExcel = CreateObject("")
= False
ExcelFile
'Get the total number of initial sheets in the worksheet
SHCount =
'Get the number of valid rows and queues in the worksheet
MaxRows =
MaxColumns =
'Get the worksheet header list
Dim StrGroup
For i = 1 To MaxColumns
StrGroup = StrGroup & "[" & i & "]" & vbTab & (1, i).Value & vbCrLf
Next
'The user specified the sub-table header and the input legal judgment
Dim Num, HardValue
Num = InputBox("Please enter the serial number of the subtable table header" & vbCrLf & StrGroup)
If Num <> "" Then
Num = Int(Num)
If Num > 0 And Num <= MaxColumns Then
HardValue = (1, Num).Value
Else
Set objExcel = Nothing
End If
Else
Set objExcel = Nothing
End If
'Get the header value of the sub-table table and the number of sub-table tables
Dim ValueGroup : j = 0
Dim a() : ReDim a(10000)
For i = 2 To MaxRows
str = (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 header value
For i = 0 To UBound(a)
If i + 2 > SHCount Then ,("sheet" & i + 1),1,-4167
Next
For i = 0 To UBound(a)
("sheet" & i + 2).Name = HardValue & "_" & a(i)
Next
'Write data in table
For i = 1 To MaxRows
For j = 1 To MaxColumns
(1).Select
str = (i,j).Value
If i = 1 Then
For k = 0 To UBound(a)
(HardValue & "_" & a(k)).Select
(i,j).Value = str
(1, MaxColumns + 1).Value = 1
Next
Else
(HardValue & "_" & (i,Num).Value).Select
If j = 1 Then x = (1, MaxColumns + 1).Value + 1
(x ,j).Value = str
If j = MaxColumns Then (1, MaxColumns + 1).Value = x
End If
Next
Next
For i = 0 To UBound(a)
(HardValue & "_" & a(i)).Select
(1, MaxColumns + 1).Value = ""
Next
Set objExcel = Nothing
"Tip: The subtable operation for " & ExcelFile & " is completed"