- 帖子
- 967
- 主題
- 0
- 精華
- 0
- 積分
- 1001
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-11-29
- 最後登錄
- 2022-5-17
 
|
回復 5# tonycho33
超版,版主大概是沒有作不出來的問題
重點是希望發問者:
1.事先作好功課,把希望的功能描述清楚,不要反反覆覆,改來改去(幾次後真的沒人想幫)
2.附上EXCEL檔案,數據應把所有可能的情形都考慮進來
SHEET B之K欄不可有資料
同一工單若有的完成,有的未完成有時會分開顯示(應可接受吧)- Sub Ex() '1.將A SHEET存到B SHEET 當J欄有出現任何值
- Dim xText As String
- xText = "<>"
- Data_Copy 10, xText
- End Sub
- Sub ExA() '2.按下按鈕時(對應工單號碼),該工單對應的所有列就複製到B SHEET空白處
- Dim xText As String
- xText = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
- Data_Copy 1, xText
- End Sub
- Private Sub Data_Copy(xF As Integer, xCriteria As String)
- Dim Sh As Worksheet
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- With Sheet7 'Sheets("A")
- .AutoFilterMode = False
- .Range("a1").AutoFilter Field:=xF, Criteria1:=xCriteria
- Set Sh = Sheets.Add
- .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
- Sh.UsedRange.Offset(1).Copy Sheet6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
- 'Sheet6->Sheet("B")
- Sh.Delete
- .AutoFilterMode = False
- .Activate
- End With
- Call deleterow '刪除B工作表之重覆列
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
- Sub deleterow() '刪除B工作表之重覆列
- With Sheet6
- R = .[A65536].End(xlUp).Row
- For RM = 2 To R
- For MM = 1 To 9 'SHEET B之K欄不可有資料
- .Cells(RM, 11) = .Cells(RM, 11) & .Cells(RM, MM)
- Next MM
- Next RM
- For I = 2 To R Step 1
- If (WorksheetFunction.CountIf(.Columns(11), .Cells(I, 11)) > 1) Then
- .Rows(I).Delete
- I = I - 1
- End If
- Next
- .Columns(11) = ""
- End With
- End Sub
 Book1111.rar (48.49 KB)
|
|
發表於 2012-2-15 11:07
| 
