此问题在此处已有答案：

Need to modify VBA script to create tabs based on item codes and subsequent information for them（1个答案）
19天前关闭
我有一个Excel表格“Sheet 1”，看起来像这样：
| 项目代码|项目描述|单位编号|数量|
| --|--|--|--|
| ABCD010204| ABCD 010204描述|U1234| 10 |
| ABCD010204| ABCD 010204描述|U3421| 10 |
| ABCD020206| ABCD 020206描述|U2345| 30 |
| ABCD020206| ABCD 020206描述|U3542| 30 |
| ABCD020206| ABCD 020206描述|U2456| 30 |
| ABCD020408| ABCD 020408描述|U3456| 20 |
| BCDE010203| BCDE 010203描述|U4567| 5 |
| BCDE010203| BCDE 010203描述|U6457| 5 |
| BCDE 020206| BCDE 020206描述|U5678| 15 |
| BCDE 020206| BCDE 020206描述|U8567| 15 |
| BCDE020410| BCDE 020410描述|U6789| 20 |
项目代码（大约40个）是连续的，不是标准的逻辑，也不总是相同的。但它们总是4个字母，后面通常是6个数字，有时是4个。

我想实现的目标：

1.目前，我可以为每种项目类型创建单独的选项卡（因此，在同一选项卡中有abcd 010204、abcd 020206等。在另一个选项卡中有bcde 0100203、bcde 020206、bcde 020410等。）
我想修改我的JavaScript脚本，从“Sheet 1”中获取所有数据，并为每个ItemCode及其后续数据创建选项卡（如下所示）。因此，每个选项卡一个唯一的项目。
| 项目代码|项目描述|单位编号|数量|
| --|--|--|--|
| ABCD010204| ABCD 010204描述|U1234| 10 |
| | | U3421 | 10 |
| 项目代码|项目描述|单位编号|数量|
| --|--|--|--|
| ABCD020206| ABCD 020206描述|U2345| 30 |
| | | U3542 | 30 |
| | | U2456 | 30 |
| 项目代码|项目描述|单位编号|数量|
| --|--|--|--|
| BCDE010203| BCDE 010203描述|U4567| 5 |
| | | U6457 | 5 |
1.有时，ItemDescr字段的数据长度约为40到60个字符。这会导致单元格无法显示整个说明。是否可以让该单元格使用该项目说明的最大长度的整个宽度？这样，我就不需要手动拖动单元格宽度来显示整个说明。

我当前的验证码如下所示：

Sub CreateTabsFromData()
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' This is the name of my main sheet
    Dim i As Long
    Dim lastRow As Long
    ' Sort source data
    With wsSource
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1").CurrentRegion.Sort Key1:=.Range("A2:A" & lastRow), Header:=xlYes
    End With
    Dim wsDestination As Worksheet
    Dim currentCode As String
    Dim newRow As Long
    Dim lastCode As String
    Dim startRow as Long
    lastCode = Left(wsSource.Cells(2, 1).Value, 4)
    startRow = 2
    For i = 2 To lastRow + 1 ' My sheet has a header, so starting from row 2.
        currentCode = Left(wsSource.Cells(i, 1).Value, 4) ' Extracting the first 4 characters of the Itemcode
        If currentCode <> lastCode Then
            Set wsDestination = Nothing
            On Error Resume Next
            Set wsDestination = ThisWorkbook.Sheets(lastCode)
            On Error GoTo 0
            If wsDestination Is Nothing Then
                ' Creating a new worksheet for the code
                Set wsDestination = ThisWorkbook.Sheets.Add(, wsSource)
                wsDestination.Name = lastCode
                wsDestination.Cells(1, 1).Resize(1, 4).Value = Array("ItemCode", "ItemDescr", "UnitNo", "Qty") ' Header row
            End If
            newRow = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Row + 1
            wsSource.Rows(startRow & ":" & i - 1).Copy wsDestination.Cells(newRow, 1)
            lastCode = currentCode
            startRow = i
        End If
    Next i
End Sub

字符串