- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 12# yagami12th - Option Explicit
- Dim Flag
- Dim myRow As Integer
- Dim newSheet As String
- Private Const XpasteSheet = "pick & num"
- 'Private Const "設為模組的私用常數 其值如字面所示 ***指定 貼上的工作表名稱
- Sub addsheetVer2()
- Static Num As Integer
- On Error GoTo AD:
- With Sheets(XpasteSheet)
- .Cells.Clear
- Num = Num + 1
- End With
- Exit Sub
- AD:
- Sheets.Add(after:=Sheets(Sheets.Count)).Name = XpasteSheet
- ''指名引數，數該excel檔有幾個sheet放在最右邊
- Resume '返回程序錯誤處
- End Sub
- Sub ChooseVer2(rowChoose, sheetName As String) '原先只有輸入列號，現在要加上工作表的名字
- If Worksheets(sheetName).Cells(rowChoose, 5) > 10 Then Flag = 1 '只選取指定sheet的資料做篩選
- End Sub
- Sub CopyPasteVer2(rowCopy, rowPaste, copySheet As String, pasteSheet) 'copy the row rowcopy in sheet with name "2330"
- Dim myStr As String 'and paste to the row rowpaste in the sheet "pick"
- Sheets(copySheet).Select
- myStr = rowCopy & ":" & rowCopy
- Rows(myStr).Select
- Selection.Copy
- Sheets(pasteSheet).Select
- myStr = "A" & rowPaste
- Range(myStr).Select
- ActiveSheet.Paste
- End Sub
- Sub main3()
- Dim i As Integer
- Dim myRange As Range
- Dim myCell
- Dim mySheet As String
- mySheet = InputBox("input the sheet name you analyze") '選擇工作表
- Set myRange = Application.InputBox("Choose the days", Type:=8)
- '幫我選取我要篩選的範圍 ** 要選取整列 **
- Set myRange = myRange.SpecialCells(xlCellTypeConstants) '選取整列有資料的範圍
- addsheetVer2 '執行上述新增工作表的程式，每次增加的不一樣，可以執行上面寫的好幾個副程式，可以讓每個程式分工合作，組合在一起
- myRow = 1
- For Each myCell In myRange '在我的myrange裡對每一個mycell，來做下面的事情
- i = myCell.Row
- Flag = 0 '不符合我的要求就跳到下一圈去看是否有符合
- ChooseVer2 i, mySheet '檢測第20行是否符合我設的條件
- If Flag = 1 Then
- CopyPasteVer2 i, myRow, mySheet, XpasteSheet '在指定的工作表作篩選後貼過去，符合設定條件，貼到新的工作表，因為不是只有第二十行，所以要寫迴圈
- myRow = myRow + 1
- End If
- Next
- End Sub
|
|
發表於 2012-2-27 08:59
| 