我有一组数据格式如下:
----- ----- ----- ----- ----- ----- ----- ----- -----
| 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年忘记了。我希望有人可以提供帮助!
答案 0 :(得分:1)
这是一种快速的方法。
将以下代码复制到包含数据的工作簿中的新模块中并运行createSummary
。
代码假设您的数据位于第一个工作表上,而SPC列是A列。我还将变量创建为公共,因此我不必将它们传递给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