- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
6#
發表於 2011-10-21 11:52
| 只看該作者
本帖最後由 hugh0620 於 2011-10-21 11:57 編輯
回復 5# Helain
樓主的問題~ 我以前也有問過~
個人貼帖的連結點資料衣條件 分SHEET
提供一個版大們的處理手法~ 自己再截取所需要的部份~ 來完成的檔案~
Data_VBA完成版_1.rar (103.16 KB)
- Private Sub CommandButton1_Click()
- Macro5 '複製貼上Data匯整
- '=====排序====
- Range("B3").End(xlToRight).End(xlDown).Sort Key1:=Range("B3"), _
- Order1:=xlAscending, Key2:=Range("C3"), Order2:=xlAscending, Key3:=Range("E3"), Order3:=xlAscending, Header:=xlYes
- '=====排序====
- '=====進階篩選====
- Range("B2").Select
- Range(Selection, Selection.End(xlDown)).Select
- Range("B2:B256").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
- "A2"), Unique:=True
- '=====進階篩選====
- Dim N As Integer
- A = Application.CountA(Sheet2.[A3:A65536]) 'A統計出需要跑幾個Sheet
- For N = 1 To A
- Sheets.Add AFTER:=Worksheets(N + 1) '新增sheet
- ActiveSheet.Range("A1") = Sheet2.Range("B2")
- ActiveSheet.Range("B1") = Sheet2.Cells(2 + N, 1)
- ActiveSheet.Range("B2") = Sheet2.Range("E2")
-
- For K = 1 To 96
- ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
- ActiveSheet.Cells(3 + Y, 2) = 1
- Y = Y + 1
- Next
- For K = 1 To 96
- ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
- ActiveSheet.Cells(3 + Y, 2) = 97
- Y = Y + 1
- Next
- For K = 1 To 96
- ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
- ActiveSheet.Cells(3 + Y, 2) = 193
- Y = Y + 1
- Next
- Y = 0
- ActiveSheet.Name = Sheet2.Cells(2 + N, 1) 'Sheet2.Range("B2") & Sheet2.Cells(2 + N, 1) '標籤名稱 僅標上數字,若有需要請把=後面改回Sheet2.Range("B2") & Sheet2.Cells(2 + N, 1)
-
- Do Until Sheet2.Cells(3 + H, 2) = ""
- If Sheet2.Cells(3 + H, 2) = Sheet2.Cells(2 + N, 1) Then
- If ActiveSheet.Cells(2, 2 + Z) = Sheet2.Cells(3 + H, 3) Then
- Select Case Sheet2.Cells(3 + H, 5)
- Case 1
- For X = 1 To 96
- ActiveSheet.Cells(2 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- Case 97
- For X = 1 To 96
- ActiveSheet.Cells(98 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- Case 193
- For X = 1 To 96
- ActiveSheet.Cells(194 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- End Select
- Else
- Z = Z + 1
- ActiveSheet.Cells(2, 2 + Z) = Sheet2.Cells(3 + H, 3)
- Select Case Sheet2.Cells(3 + H, 5)
- Case 1
- For X = 1 To 96
- ActiveSheet.Cells(2 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- Case 97
- For X = 1 To 96
- ActiveSheet.Cells(98 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- Case 193
- For X = 1 To 96
- ActiveSheet.Cells(194 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
- Next
- End Select
- End If
- End If
- H = H + 1
- Loop
- H = 0
- Z = 0
- ActiveSheet.Rows("2:2").Select
- Selection.NumberFormatLocal = "yyyy/m/d"
- Next
- End Sub
複製代碼 |
|