2012-02-07 11 views
2

私はそうのようにフォーマットのデータのセットを持っている:私はそれはこのようにフォーマットすることにしたい再フォーマット&連結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を含める必要があります。私はまた、2つの価格の低い方が欲しい。

SPCまたは数百につき1つの製品しか存在できません。それぞれは、すべての利用可能なオプションを持つ独自の行を持つ必要があります。

私はこれがVBAを使って行うことができると確信しています。これは1996-98年に非常に簡単に学び、1999年に忘れました。誰かが助けてくれることを願っています!

+2

VBAを1年間保存できましたか?ブラボー – Polynomial

+0

@Polynomial今私が覚えているのは、すべて「薄暗い」です。私はそれが何をしているのか分からない。 –

+0

「Dim」は「dimension」を表し、変数を宣言します。私は90年代初めにBASICをコーディングしていたので覚えています。 – Polynomial

答えて

1

これは簡単な方法です。

データを含むブックの新しいモジュールに以下のコードをコピーし、createSummaryを実行します。

コードでは、データが最初のワークシートにあり、SPC列がA列であると想定しています。変数をpublicとして作成したため、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 
+0

ありがとうございました。それは動作しますが、 'run time 91'というエラーが発生します。さて、それを読んで、それが私の記憶を何とかリフレッシュするかどうかを見てみましょう! –

+0

Hm。私はあなたのデータが正確に私はそれを再作成したものではないため、あなたはエラーが発生していると思います。どのラインでエラーが発生していますか? – mischab1

関連する問題