返回列表 上一主題 發帖

[發問] 如何產生不同名稱worksheet

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
1# 跳轉到 »
發表於 2011-10-21 11:52 | 顯示全部帖子
本帖最後由 hugh0620 於 2011-10-21 11:57 編輯

回復 5# Helain

    樓主的問題~ 我以前也有問過~  
    個人貼帖的連結點資料衣條件 分SHEET
    提供一個版大們的處理手法~ 自己再截取所需要的部份~ 來完成的檔案~
    Data_VBA完成版_1.rar (103.16 KB)
  1. Private Sub CommandButton1_Click()
  2. Macro5 '複製貼上Data匯整

  4. '=====排序====
  5. Range("B3").End(xlToRight).End(xlDown).Sort Key1:=Range("B3"), _
  6. Order1:=xlAscending, Key2:=Range("C3"), Order2:=xlAscending, Key3:=Range("E3"), Order3:=xlAscending, Header:=xlYes
  7. '=====排序====

  9. '=====進階篩選====
  10.     Range("B2").Select
  11.     Range(Selection, Selection.End(xlDown)).Select
  12.     Range("B2:B256").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  13.         "A2"), Unique:=True
  14. '=====進階篩選====

  16. Dim N As Integer

  18. A = Application.CountA(Sheet2.[A3:A65536])  'A統計出需要跑幾個Sheet

  20. For N = 1 To A

  22.   Sheets.Add AFTER:=Worksheets(N + 1)           '新增sheet
  23.   ActiveSheet.Range("A1") = Sheet2.Range("B2")
  24.   ActiveSheet.Range("B1") = Sheet2.Cells(2 + N, 1)
  25.   ActiveSheet.Range("B2") = Sheet2.Range("E2")
  26.   
  27.     For K = 1 To 96
  28.     ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
  29.     ActiveSheet.Cells(3 + Y, 2) = 1
  30.     Y = Y + 1
  31.     Next
  32.     For K = 1 To 96
  33.     ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
  34.     ActiveSheet.Cells(3 + Y, 2) = 97
  35.     Y = Y + 1
  36.     Next
  37.     For K = 1 To 96
  38.     ActiveSheet.Cells(3 + Y, 1) = "POINT_" & K
  39.     ActiveSheet.Cells(3 + Y, 2) = 193
  40.     Y = Y + 1
  41.     Next
  42.     Y = 0
  43.   ActiveSheet.Name = Sheet2.Cells(2 + N, 1) 'Sheet2.Range("B2") & Sheet2.Cells(2 + N, 1) '標籤名稱 僅標上數字,若有需要請把=後面改回Sheet2.Range("B2") & Sheet2.Cells(2 + N, 1)
  44.    
  45.     Do Until Sheet2.Cells(3 + H, 2) = ""
  46.         If Sheet2.Cells(3 + H, 2) = Sheet2.Cells(2 + N, 1) Then
  47.             If ActiveSheet.Cells(2, 2 + Z) = Sheet2.Cells(3 + H, 3) Then
  48.                 Select Case Sheet2.Cells(3 + H, 5)
  49.                     Case 1
  50.                         For X = 1 To 96
  51.                         ActiveSheet.Cells(2 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  52.                         Next
  53.                     Case 97
  54.                         For X = 1 To 96
  55.                         ActiveSheet.Cells(98 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  56.                         Next
  57.                     Case 193
  58.                         For X = 1 To 96
  59.                         ActiveSheet.Cells(194 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  60.                         Next
  61.                 End Select
  62.             Else
  63.                 Z = Z + 1
  64.                 ActiveSheet.Cells(2, 2 + Z) = Sheet2.Cells(3 + H, 3)
  65.                 Select Case Sheet2.Cells(3 + H, 5)
  66.                     Case 1
  67.                         For X = 1 To 96
  68.                         ActiveSheet.Cells(2 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  69.                         Next
  70.                     Case 97
  71.                         For X = 1 To 96
  72.                         ActiveSheet.Cells(98 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  73.                         Next
  74.                     Case 193
  75.                         For X = 1 To 96
  76.                         ActiveSheet.Cells(194 + X, 2 + Z) = Sheet2.Cells(3 + H, 5 + X)
  77.                         Next
  78.                 End Select
  79.             End If
  80.         End If
  81.     H = H + 1
  82.     Loop

  84.     H = 0
  85.     Z = 0
  86.     ActiveSheet.Rows("2:2").Select
  87.     Selection.NumberFormatLocal = "yyyy/m/d"
  88. Next
  89. End Sub
複製代碼
學習才能提升自己

TOP

        靜思自在 : 天上最美是星星，人生最美是溫情。
返回列表 上一主題