Private Sub formjpsto過度表復制() ' ' Macro2 Macro 111,22222,3333 ' qunxingw 在 2015/11/21 錄製的巨集 ' ' Application.Run "'複製 -實驗.xls'!copyjpstemp" Application.Run "'複製 -實驗.xls'!deletemprow" Application.Run "'複製 -實驗.xls'!COPY過渡表" End Sub Private Sub 總表處理() Dim rs As Long Dim rm As Long rs = range("A65500").End(xlUp).Row + 1 rm = range("L65500").End(xlUp).Row For i = rm To rs '金重處理 Select Case Cells(i, 1) Case "CX" Cells(i, 12) = Cells(i, 5) Case "MR" Cells(i, 12) = Cells(i, 5) Case "MZ" Cells(i, 12) = Cells(i, 5) Case "RC" Cells(i, 12) = Cells(i, 5) Case "RA" Cells(i, 12) = Cells(i, 5) Case "RD" Cells(i, 12) = Cells(i, 5) Case "RO" Cells(i, 12) = Cells(i, 5) Case "CL" Cells(i, 12) = -Cells(i, 5) Case "MI" Cells(i, 12) = -Cells(i, 5) Case "CL" Cells(i, 12) = -Cells(i, 5) Case "MX" Cells(i, 12) = -Cells(i, 5) End Select '金質處理 Select Case Cells(i, 4) Case "9k" Cells(i, 12) = "9K" Case "9KW" Cells(i, 11) = "9K" Case "9KY" Cells(i, 11) = "9K" Case "10K" Cells(i, 11) = "10K" Case "10KY" Cells(i, 11) = "10K" Case "10KW" Cells(i, 11) = "10K" Case "10KL" Cells(i, 11) = "10KL" Case "10KLR" Cells(i, 11) = "10KL" Case "14K" Cells(i, 11) = "14K" Case "14KW" Cells(i, 11) = "14K" Case "14KY" Cells(i, 11) = "14K" Case "18K" Cells(i, 11) = "18K" Case "18KW" Cells(i, 11) = "18K" Case "18KR" Cells(i, 11) = "18K" Case "18KEW" Cells(i, 11) = "18K" Case "18KLWN" Cells(i, 11) = "18KL" Case "18KLY" Cells(i, 11) = "18KL" Case "18KL" Cells(i, 11) = "18KL" Case "18KLR" Cells(i, 11) = "18KL" Case "18KL" Cells(i, 11) = "18KL" Case Else Cells(i, 11) = Cells(i, 4) End Select Next End Sub Private Sub copyjpstemp() ' ' '1111111111111 ' qunxingw 在 2015/11/19 錄製的巨集 ' ' Windows("COPY_JPS.xls").Activate Cells.Select Selection.copy Windows("複製 -實驗.xls").Activate range("A1").Select ActiveSheet.Paste Columns("D:E").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("E:E").Select Selection.Delete Shift:=xlToLeft Columns("F:M").Select Selection.Delete Shift:=xlToLeft Columns("G:I").Select Selection.Delete Shift:=xlToLeft Columns("I:J").Select Selection.Delete Shift:=xlToLeft End Sub Sub deletemprow() '2222222222222222 Dim m, n As Long Dim rng As range For i = 1 To 1000 m = range("a65530").End(xlUp).Row For Each rng In range("a1", Cells(50000, 1).End(xlUp)) If rng = "AX" Or rng = "AZ" Or rng = "RW" Or rng = "IW" Or rng = "M1" Or rng = "M2" Then rng.EntireRow.Delete Shift:=xlUp ElseIf rng = "MX" And Cells(rng.Row, 4) = "ALLOY" Then rng.EntireRow.Delete Shift:=xlUp End If Next n = m = range("a65530").End(xlUp).Row If m = n Then Exit For End If Next End Sub Sub COPY過渡表() '3333333333333333 Dim rs, rm As Long rs = Worksheets("過度表").range("a65500").End(xlUp).Row Worksheets("過度表").range("a2:h" & rs).Select Selection.copy End Sub Sub 粘貼總表的位() Dim rm As Long rm = Worksheets("總表").range("a65500").End(xlUp).Row + 1 Worksheets("總表").range("a" & rm).Select ' Worksheets("總表").range("A" & rm).Select End Sub