- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2011-3-23 10:09
| 只看該作者
本帖最後由 GBKEE 於 2011-3-23 11:17 編輯
回復 5# hugh0620
Data匯整 的工作表序號不連續 18,19,21,22 缺 20
改為 Sheet2.Cells(2 + N, 1).Text
For N = 1 To A
'Sheets.Add AFTER:=Worksheets(N + 1) '新增sheet
Sheets(Sheet2.Cells(2 + N, 1).Text).Activate '''
Sheets(Sheet2.Cells(2 + N, 1).Text).Cells.Clear
修改你的程式如下- Private Sub CommandButton1_Click()
- Dim N As Integer, E
- CommandButton2_Click
- With Sheets("Data匯整")
- Sheets("原始Data").Range("A2").CurrentRegion.Copy .Range("B2")
- '=====排序====
- .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
- '=====進階篩選====
- End With
- On Error GoTo Sheet_Add '有錯誤到 行號 Sheet_Add
- A = Application.CountA(Sheet2.[A3:A65536]) 'A統計出需要跑幾個Sheet
- For N = 1 To A
- Sheets(Sheet2.Cells(2 + N, 1).Text).Select
- With ActiveSheet
- .Cells.Clear '''
- .Range("A1") = Sheets("Data匯整").Range("B2")
- .Range("B1") = Sheets("Data匯整").Cells(2 + N, 1)
- .Range("B2") = Sheets("Data匯整").Range("E2")
- For Each E In Array(1, 97, 193)
- With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
- .Cells(1) = "POINT_1"
- .Cells(2) = "POINT_2"
- .Cells.Resize(2).AutoFill .Cells.Resize(96)
- .Cells(1, 2).Resize(96) = E
- End With
- Next
- End With
- 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")
- 'Selection.NumberFormatLocal = "yyyy/m/d"
- ActiveSheet.Rows("2:2").NumberFormatLocal = "yyyy/m/d"
- Next
- Exit Sub
- Sheet_Add: '行號
- If Err <> 9 Then
- MsgBox "錯誤值 " & Err & " 請檢查錯誤 !!!"
- Exit Sub
- End If
- With Sheets.Add(AFTER:=Worksheets(N + 1)) '新增sheet
- .Name = Sheet2.Cells(2 + N, 1) '標籤名稱
- End With
- Resume Next '返回錯誤處
- End Sub
|
|
發表於 2011-3-22 12:41
| 
