重新格式化和连接Excel电子表格数据
我有一组数据格式如下：
----- ----- ----- ----- ----- ----- ----- ----- ----- | A | | B | | C | | D | | E | | F | | G | | H | | I | |---------------------------------------------------------------------------------------------------------------------------------------| | SPC | Department | Sub Department | Brand | Colour Name | Size | Description | Price | Carton Size | |---------------------------------------------------------------------------------------------------------------------------------------| | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White | S | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White | M | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White | L | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White | XL | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White | 2XL | Kustom Kit Workwear Pique Polo | 4.75 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | S | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | M | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | L | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | XL | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | 2XL | Kustom Kit Workwear Pique Polo | 4.75 | 40 | | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | Red | 3XL | Kustom Kit Workwear Pique Polo | 4.75 | 40 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 30" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 32" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 34" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 36" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 38" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 40" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue | 42" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 30" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 32" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 34" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 36" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 38" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 40" | Regatta Action Shorts | 9.5 | 24 | | J172S | Workwear | Mens Workwear | Regatta | Lichen | 42" | Regatta Action Shorts | 9.5 | 24 | |---------------------------------------------------------------------------------------------------------------------------------------| 我希望它的格式如下所示：
|-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------| | SPC | Department | Sub Department | Brand | Colour Names | Sizes | Description | Price | Carton Size | |-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------| | KK400 | Polo Shirts | Mens Short Sleeve Polo | Kustom Kit | White, Red | S, M, L, XL, 2XL, 3XL | Kustom Kit Workwear Pique Polo | 4.25 | 40 | | J172S | Workwear | Mens Workwear | Regatta | Navy Blue, Lichen | 30", 32", 34", 36", 38", 40", 42" | Regatta Action Shorts | 9.5 | 24 | |-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
正如你所看到的，我需要颜色和大小连接。 即使上面的马球没有3XL的白色，我仍然需要把3XL列入决赛桌。 我也想要两个价格中较低的一个。
每个SPC只能有一个产品或数百个。 每个人都需要有自己的所有可用选项。
我非常肯定，这可以使用VBA来完成，我在1996 – 98年学习了一些非常简单的知识，并在1999年忘记了。我希望有人能帮助！
这是一个快速的方法来做到这一点。
将以下代码复制到具有该数据的工作簿中的一个新模块并运行createSummary 。
该代码假设您的数据在第一个工作表上，而SPC列是列A.我也创build了variables作为公共，所以我不必将它们传递给copyToSummary 。
Option Explicit Public Enum ColumnOffsets Dept = 1 SubDept = 2 Brand = 3 ColourName = 4 Size = 5 Desc = 6 Price = 7 CartonSz = 8 End Enum Public rDetail As Range, rSum As Range Public sColourNames As String, sSizes As String, dLowPrice As Double Public Sub createSummary() ' Creates a summary worksheet in this workbook. Dim sht As Worksheet 'Application.ScreenUpdating = False ' uncomment to make the macro run faster ' assumes the detail data is on the first worksheet with the header starting at A1 Set rDetail = ThisWorkbook.Sheets(1).Range("A1") Set sht = ThisWorkbook.Sheets.Add(after:=rDetail.Parent) sht.Name = "Summary" Set rSum = sht.Range("A1") ' sort detail to make sure all rows with the same SPC are next to each other Range(rDetail, rDetail.SpecialCells(xlCellTypeLastCell)).Sort rDetail, Header:=xlYes ' copy header Range(rDetail, rDetail.End(xlToRight)).Copy rSum.PasteSpecial xlPasteAll Application.CutCopyMode = False ' move down to first data row Set rSum = rSum.Offset(1) Set rDetail = rDetail.Offset(1) ' loop thru data Do While rDetail <> "" ' summarise detail sColourNames = Append(rDetail.Offset(0, ColourName), sColourNames) sSizes = Append(rDetail.Offset(0, Size), sSizes) If dLowPrice = 0 Or rDetail.Offset(0, Price) < dLowPrice Then dLowPrice = rDetail.Offset(0, Price) End If ' add to sumary worksheet If rDetail <> rDetail.Offset(1) Then copyToSummary ' if screen updating is turned off, refersh the screen occasionally so Excel doesn' look like it is locked up. ' uncomment the below code to refresh the screen every 5 rows on the summary worksheet. ' If rSum.Row Mod 5 = 0 Then ' Application.ScreenUpdating = True DoEvents ' Application.ScreenUpdating = False ' End If ' reset summary variables sColourNames = "" sSizes = "" dLowPrice = 0 End If Set rDetail = rDetail.Offset(1) Loop ' auto-fit summary page columns Range(rSum, rSum.End(xlToRight).End(xlUp)).Columns.AutoFit Application.ScreenUpdating = True MsgBox "Done." End Sub Private Function Append(ByVal sAppendThis As String, ByVal sToSummary As String) As String ' appends given value if it isn't already in summary. ' Note: The '|' are added to prevent "Blue" from matching to "Navy Blue". They are removed in copyToSummary. sAppendThis = "|" & Trim(sAppendThis) & "|" If Len(sToSummary) = 0 Then sToSummary = sAppendThis Else If InStr(LCase(sToSummary), LCase(sAppendThis)) = 0 Then sToSummary = sToSummary & ", " & sAppendThis End If End If Append = sToSummary End Function Private Sub copyToSummary() ' copies summed detail of current spc to summary sheet rSum.Activate rSum = rDetail rSum.Offset(0, Dept) = rDetail.Offset(0, Dept) rSum.Offset(0, SubDept) = rDetail.Offset(0, SubDept) rSum.Offset(0, Brand) = rDetail.Offset(0, Brand) rSum.Offset(0, ColourName) = Replace(sColourNames, "|", "") rSum.Offset(0, Size) = Replace(sSizes, "|", "") rSum.Offset(0, Desc) = rDetail.Offset(0, Desc) rSum.Offset(0, Price) = dLowPrice rSum.Offset(0, CartonSz) = rDetail.Offset(0, CartonSz) Set rSum = rSum.Offset(1) End Sub