- 帖子
- 193
- 主題
- 29
- 精華
- 0
- 積分
- 222
- 點名
- 0
- 作業系統
- Windows7
- 軟體版本
- OFFICE2013
- 閱讀權限
- 20
- 註冊時間
- 2015-9-18
- 最後登錄
- 2023-4-29
|
18#
發表於 2016-1-24 00:25
| 只看該作者
以上的問題單點突破後只剩下兩個問題...
希望有高手能替我解答一下
Q1.欄位線的劃置能全部細線條 , 依照B/D No 不同畫粗線條嗎?
目前好像不同的MO 畫粗線
如圖片 原本是這樣
想讓劃線變成這樣
1. 新增功能
1-1. 程式中報表上CUSTNAME 欄位(V欄位)中如果只有 CSP / L1 / L2 / 字串則整個刪除
1-2. 保留 ENG / HQCSP / HQ-CSP/ HQ-L1 / HQ-L2 / HQL1 / HQL2
1-3. 然後移去ENG 移至ENG資料表, HQ CSP系列移至CSP資料表, HQ L1 / HQ L2 系列移至Other資料表
 help.rar (292.68 KB)
- Dim UType%
- Sub 新報表_匯入()
- Dim xFile$, x As New Application, xB As Workbook, xS As Worksheet
- Dim RepSht As Worksheet, xR As Range, xLab As Range, xAddress$
- Set RepSht = Sheets("FMC")
- Application.ScreenUpdating = False
- RepSht.UsedRange.EntireRow.Delete
- Dim currentPKG, currentDevice, whichFirst As String
- Dim index As Integer
- Dim hasReport As Boolean
- title_row = 8
- hasReport = False
- For i = 1 To Workbooks.Count
- With Workbooks(i).Sheets(1)
- If .Range("A" & title_row).Value Like "LOTID*" And .Range("D" & title_row).Value Like "TYPE*" And .Range("M" & title_row) Like "QTY*" Then
- Set xS = Workbooks(i).Sheets(1)
- hasReport = True
- i = Workbooks.Count + 1
- End If
- End With
- Next i
- If hasReport = False Then MsgBox "找不到報表檔！ ": Exit Sub
- R = xS.Cells(Rows.Count, 1).End(xlUp).Row + 5
- With RepSht
- .Range("A1:A" & R) = xS.Range("AJ1:AJ" & R).Value 'pkg
- .Range("B1:B" & R) = xS.Range("B1:B" & R).Value 'MO
-
- .Range("C1:C" & R).NumberFormatLocal = "@" 'Date time
- .Range("C1:C" & R) = xS.Range("L1:L" & R).Value 'Date time
-
- .Range("D1:D" & R) = xS.Range("A1:A" & R).Value 'LOTID
- .Range("E1:E" & R) = xS.Range("D1:D" & R).Value 'DIE TYPE
- .Range("F1:F" & R) = xS.Range("P1:P" & R).Value 'STEP
- .Range("G1:G" & R) = xS.Range("M1:M" & R).Value ' MO QTY
- .Range("AA1:AA" & R) = xS.Range("Q1:Q" & R).Value ' QTY
- .Range("H8").Value = "TBG1"
- .Range("I8").Value = "PGH1"
- .Range("J8").Value = "SLS1"
- .Range("K8").Value = "WG"
- .Range("L8").Value = "DE01"
- .Range("M8").Value = "WM01"
- .Range("N8").Value = "FL01"
- .Range("O8").Value = "LWS1"
- .Range("P8").Value = "WS01"
- .Range("Q8").Value = "UTI1"
- .Range("R8").Value = "VS01"
- .Range("S8").Value = "QVS1"
- .Range("T8").Value = "RQVS1"
- .Range("U8").Value = "DB"
- .Range("V1:W" & R) = xS.Range("E1:F" & R).Value 'CUST DEVICE
- .Range("X1:X" & R) = xS.Range("AD1:AD" & R).Value 'Substrate
- .Range("Y1:Y" & R) = xS.Range("AE1:AE" & R).Value 'B/D No
- .Range("Z1:Z" & R) = xS.Range("AQ1:AQ" & R).Value 'flow
- .Range("A8").Value = "PKG"
- .Range("A7").Value = ""
- .Range("X8").Value = "Substrate"
- .Range("X7").Value = ""
- .Range("Y8").Value = "B/D No."
- .Range("Y7").Value = ""
- .Range("D2").Value = ""
- .Range("AA8").Value = ""
- .Range("A1").Value = "1ST Flow On Hand Report"
- .Range("A2").Value = Now()
- End With
- Dim RRR&, xAArea As Range, xRRR As Range, xHH As Range, Q, TTTT, XXX
- RRR = [FMC!A65536].End(xlUp).Row: If RRR < 9 Then Exit Sub
- Set xAArea = Sheets("FMC").Range("A9:A" & RRR)
- For Each xRRR In xAArea
- Q = xRRR(1, 26)
- Q = Mid(Q & ",QVS", InStr(Q, "QVS") + 4) '取 QVS 以後字串
- For Each TTTT In Array("SPC", "SCL")
- XXX = InStr(Q, TTTT): If XXX > 0 Then xRRR(1, 26) = Left(Q, XXX + 2): Exit For
- Next
- Next
- With RepSht
- ' For g = 3500 To 8 Step -1
- ' If .Cells(g, "V") Like "*CSP*" Or .Cells(g, "V") Like "*L1*" Or .Cells(g, "V") Like "*L2*" _
- ' Or .Cells(g, "V") Like "*ENG*" Or .Cells(g, "A") Like "LQFP*" Or .Cells(g, "A") Like "PLCC*" _
- ' Or .Cells(g, "A") Like "SOP*" Or .Cells(g, "A") Like "SSOP*" Or .Cells(g, "A") Like "TSOP*" _
- ' Or .Cells(g, "A") Like "TSSOP*" Or .Cells(g, "A") Like "TFBGA*" Then
- ' .Rows(g).Delete
- ' End If
- ' Next
- RepSht.Select
- For h = 9 To 3500
- .Cells(h, "AA").Select
- Selection.Cut
- Select Case .Cells(h, "F").Value
- Case "TBG1"
- .Cells(h, "H").Select
- ActiveSheet.Paste
- Case "PGH1"
- .Cells(h, "I").Select
- ActiveSheet.Paste
- Case "SLS1"
- .Cells(h, "J").Select
- ActiveSheet.Paste
- Case "DE01"
- .Cells(h, "L").Select
- ActiveSheet.Paste
- Case "WM01"
- .Cells(h, "L").Select
- ActiveSheet.Paste
- Case "FL01"
- .Cells(h, "N").Select
- ActiveSheet.Paste
- Case "LWS1"
- .Cells(h, "O").Select
- ActiveSheet.Paste
- Case "WS01"
- .Cells(h, "P").Select
- ActiveSheet.Paste
- Case "UTI1"
- .Cells(h, "Q").Select
- ActiveSheet.Paste
- Case "VS01"
- .Cells(h, "R").Select
- ActiveSheet.Paste
- Case "QVS1"
- .Cells(h, "S").Select
- ActiveSheet.Paste
- Case "RQVS1"
- .Cells(h, "T").Select
- ActiveSheet.Paste
- Case "DB"
- .Cells(h, "U").Select
- ActiveSheet.Paste
- End Select
- Next
- For e = 9 To 3500
- If .Cells(e, "F") Like "WG*" Then
- .Cells(e, "AA").Select
- Selection.Cut
- .Cells(e, "K").Select
- ActiveSheet.Paste
- End If
- Next
- End With
- 'xB.Close 0
- Dim RR&, xArea As Range, xRR As Range, xH As Range, T, TT, XX
- RR = [FMC!A65536].End(xlUp).Row: If RR < 9 Then Exit Sub
- Set xArea = Sheets("FMC").Range("A9:A" & R)
- For Each xRR In xArea
- T = xRR(1, 25): xRR(1, 25) = Mid(T, InStr(T, "-") + 1)
- xRR(1, 24) = Right(xRR(1, 24), 9)
-
- T = xRR(1, 5): T = Left(T, 2) & "-" & Mid(T, 24, 1) & "-" & Mid(T, 23, 4)
- Next
- xArea.Resize(, 26).Sort Key1:=xArea(1, 1), Order1:=xlAscending, _
- Key2:=xArea(1, 25), Order2:=xlAscending, Header:=xlNo
- Application.DisplayAlerts = False
- For Each xRR In xArea
- If xRR & xRR(1, 2) <> xRR(0) & xRR(0, 2) Then Set xH = xRR
- If xRR & xRR(1, 2) <> xRR(2) & xRR(2, 2) Then
- Range(xH, xRR).Merge: Range(xH(1, 2), xRR(1, 2)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 3), xRR(1, 3)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 7), xRR(1, 7)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 22), xRR(1, 22)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 23), xRR(1, 23)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 24), xRR(1, 24)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 25), xRR(1, 25)).Merge
- Range(xH, xRR).Merge: Range(xH(1, 26), xRR(1, 26)).Merge
- Range(xH, xRR(1, 26)).Borders.LineStyle = 1
- For i = 7 To 10
- Range(xH, xRR(1, 26)).Borders(i).Weight = xlMedium
- Next i
- End If
- Next
- With RepSht
- Sheets("FMC").Select
- Cells.Select
- Selection.Font.Size = 14
- With Selection.Font
- .Name = "Arial"
- .Size = 14
- .Strikethrough = False
- .Superscript = False
- .Subscript = False
- .OutlineFont = False
- .Shadow = False
- .Underline = xlUnderlineStyleNone
- .ThemeColor = xlThemeColorLight1
- .TintAndShade = 0
- .ThemeFont = xlThemeFontNone
- End With
- Range("A8:Z8").Select
- With Selection.Interior
- .Pattern = xlSolid
- .PatternColorIndex = xlAutomatic
- .Color = 255
- .TintAndShade = 0
- .PatternTintAndShade = 0
- End With
- With Selection.Font
- .ThemeColor = xlThemeColorDark1
- .TintAndShade = 0
- End With
- End With
- Range("A8").Select
- ActiveWindow.Zoom = 63
- Call 調整
-
- End Sub
- Sub 報表_清除()
- Sheets("FMC").UsedRange.EntireRow.Delete
- End Sub
- Sub 調整()
- Dim RepSht As Worksheet
- Set RepSht = Sheets("FMC")
- With RepSht
- Columns("A:A").Select
- Selection.ColumnWidth = 30
- Columns("B:B").Select
- Selection.ColumnWidth = 11.63
- Columns("C:C").Select
- Selection.ColumnWidth = 16
- Columns("D:D").Select
- Selection.ColumnWidth = 20.88
- Columns("E:E").Select
- Selection.ColumnWidth = 8.25
- Columns("F:F").Select
- Selection.ColumnWidth = 9.25
- Columns("G:G").Select
- Selection.ColumnWidth = 10
- Selection.NumberFormatLocal = "#,##0_ "
- Columns("H:U").Select
- Selection.ColumnWidth = 8.63
- Columns("V:V").Select
- Selection.ColumnWidth = 40.38
- ActiveWindow.SmallScroll ToRight:=11
- Columns("W:W").Select
- Selection.ColumnWidth = 59.75
- Columns("X:X").Select
- Selection.ColumnWidth = 15.5
- Columns("Y:Y").Select
- Selection.ColumnWidth = 10.5
- ActiveWindow.SmallScroll ToRight:=4
- Columns("Z:Z").Select
- Selection.ColumnWidth = 93.38
- Range("A7").Select
- End With
- End Sub
|
|
發表於 2016-1-24 20:51
| 
