Question

H，我有这种格式的库存表。（如下图所示，不知道如何在此处添加表格）。公司名称和类别不在单独的列中。而是列在产品列中。我想添加2个额外的列，一个用于公司，一个用于类别，并相应地向每一行添加详细信息。

原始格式

所需格式

最简单的方法是什么？

Answer 1

这应该做你想要的，它假设你的数据从A列开始：

Sub ChangeFormat()
Dim CompanyName As String, Catgory As String, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For X = 2 To LR
    If X > LR Then Exit For
    If Left(UCase(Range("A" & X).text), 8) = "COMPANY:" Then
        CompanyName = Trim(Right(Range("A" & X).text, Len(Range("A" & X).text) - 8))
        Rows(X).Delete
        LR = LR - 1
    End If
    If Left(UCase(Range("A" & X).text), 9) = "CATEGORY:" Then
        Category = Trim(Right(Range("A" & X).text, Len(Range("A" & X).text) - 9))
        Rows(X).Delete
        LR = LR - 1
    End If
    Range("E" & X).Formula = CompanyName
    Range("F" & X).Formula = Category
Next
End Sub

它会扫描，当它找到其中一个标题时，它会将该值分配给变量然后删除该行，如果找不到，那么它会假定它是数据并将公司和类别发布到E和F列（我认为Catagory拼写错误但我的拼写错误了。）

确保在运行此数据之前备份数据，因为它会修改您拥有的数据。

Answer 2

这是一个执行任务的宏。您可以更改代码中指示的工作表名称。

Sub InventoryReformat()
Dim ar
Dim i As Long
Dim wRow As Long
Dim sTxt As String, sCompany As String, sCategory As String
Dim wsS As Worksheet, wsD As Worksheet

Set wsS = Sheets("SOURCE_DATA")                                            'Change as required
Set wsD = Sheets("DESTINATION")                                            'Change as required

ar = wsS.Range("A1").CurrentRegion.Value                                   'Change start cell as required
wRow = 1                                                                   'Change first destination row as required
With wsD
    .Cells(wRow, 1).Resize(1, 6) = Split("PRODUCT|COST PRICE|SALE PRICE|TAX|CATEGORY|COMPANY", "|")
    wRow = wRow + 1
    For i = 2 To UBound(ar, 1)
        sTxt = ar(i, 1)
        If InStr(1, sTxt, "Company") > 0 Then
            sCompany = Trim(Split(sTxt, ":")(1))
        Else
            If InStr(1, sTxt, "Category") > 0 Then
                sCategory = Trim(Split(sTxt, ":")(1))
            Else
                .Cells(wRow, 1) = ar(i, 1)
                .Cells(wRow, 2) = ar(i, 2)
                .Cells(wRow, 3) = ar(i, 3)
                .Cells(wRow, 4) = ar(i, 4)
                .Cells(wRow, 5) = sCategory
                .Cells(wRow, 6) = sCompany
                wRow = wRow + 1
            End If
        End If
    Next i
    .Cells(wRow - 1, 1).CurrentRegion.Columns.AutoFit
End With
End Sub

。希望这会对你有所帮助。

添加2个新列，其中行标题中包含值

2 个答案: