|
Dim k, l, m, ll, h, costCode As Range
Public n
Dim job, costCode1, costCode2
Dim shift, dayReport As String
Public recordNumb
Sub VERTES()
'Worksheets("Òðàíñï ïåðñ").Activate
box = MsgBox("Ýòî ïîñëåäíèé ëèñò ñ äàííûìè ïî ïåðñîíàëó?", vbYesNo, "ÏÎÄÒÂÅÐÆÄÅÍÈÅ")
If box = vbYes Then
e = ActiveSheet.Index 'Âíîñèò íîìåð ëèñòà
Else:
GoTo 6
End If
recordNumb = InputBox("Ââåñòè ïîñëåäíþþ çàïèñü:") ' íåîáõîäèìî çàäàòü ïîñëåäíèé ïîðÿäêîâûé íîìåð(ñìîòðèì ïî âåðòèñ)
Sheets(1).Select
dateReport = Cells(5, "H").Value ' Äàòà ñåãîäíÿøíåãî îò÷åòà
n = 1
a = Sheets.Count
Sheets.Add after:=Sheets(a)
a = Sheets.Count
Sheets(a).Name = "VERTES"
'''''''''''''''''''''''''''''''''''''''''''''''''''Çàãîëîâêè è øèðèíà ñòîëáöîâ äëÿ ïåðåäà÷è â Access
Columns("A").ColumnWidth = 10
Cells(1, "A").Value = "Emp Number"
Columns("B").ColumnWidth = 12
Cells(1, "B").Value = "No and Co"
Columns("C").ColumnWidth = 25
Cells(1, "C").Value = "First/Last Name"
Columns("D").ColumnWidth = 8
Cells(1, "D").Value = "Rate"
Columns("E").ColumnWidth = 5
Cells(1, "E").Value = "ST"
Columns("F").ColumnWidth = 5
Cells(1, "F").Value = "OT"
Columns("G").ColumnWidth = 8
Cells(1, "G").Value = "JOB"
Columns("H").ColumnWidth = 10
Cells(1, "H").Value = "Cost Code"
Columns("I").ColumnWidth = 8
Cells(1, "I").Value = "Crew"
Columns("J").ColumnWidth = 8
Cells(1, "J").Value = "Company"
Columns("K").ColumnWidth = 9
Cells(1, "K").Value = "Cost Type"
Columns("L").ColumnWidth = 10
Cells(1, "L").Value = "Entitlement"
Columns("M").ColumnWidth = 5
Cells(1, "M").Value = "SHIFT"
Columns("N").ColumnWidth = 9
Cells(1, "N").Value = "Substance"
Columns("O").ColumnWidth = 9
Cells(1, "O").Value = "Day Rater"
Columns("P").ColumnWidth = 9
Cells(1, "P").Value = "Work Date"
Columns("Q").ColumnWidth = 12
Cells(1, "Q").Value = "Time Ticket"
Columns("R").ColumnWidth = 12
Cells(1, "R").Value = "Record Number"
Rows(1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For q = 2 To e
Sheets(q).Select
x = ActiveSheet.PageSetup.PrintArea
vv = Range(x).Columns.Count
v = Range(x).Rows.Count
w = 13
shift = Left(Sheets(q).Cells(6, "E").Value, 1) 'Çàäàåò ïåðâûé shift ëèñòà
'''''''''''''''''''''''''''''''''''''''''''''''''''Âñÿ ýòà áàéäà òîëüêî äëÿ Time Ticket'''''
dateReport2 = Format(dateReport, "yy mm dd")
badYear = 1999
dateTicket = Left(dateReport2, 2) & Mid(dateReport2, 4, 2) & Right(dateReport2, 2)
badDate1 = 1 & "/" & 1 & "/" & badYear + q
numberTicket = Format(badDate1, "yy")
timeTicket = dateTicket & numberTicket
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do
w = w + 1
Cells(w, "G").NumberFormat = "@"
Sheets(q).Cells(w, "G").FormulaR1C1 = Sheets(q).Cells(w, "G").FormulaR1C1
k = Sheets(q).Cells(w, "G").Value
kk = Sheets(q).Cells(w, "H").Value
If kk = "n/a" Then
Call Ekoshelf
Sheets(a).Cells(n, 17).Value = timeTicket
GoTo 11
End If
Select Case k
Case 1 To 10
GoTo 1
Case "n/a"
GoTo 1
Case Else
GoTo 2
End Select
1
For i = 9 To vv - 2 Step 2
Sheets(q).Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''''Ïðîâåðÿåì íàëè÷àå ÷àñîâ ó ÷åëîâåêà
hours = Sheets(q).Cells(w, i).Value
Select Case hours
Case 1 To 24, "0"
If Sheets(q).Cells(w, i).Value = "0" Then
Sheets(q).Cells(w, i).Value = 0.000001
End If
15
recordNumb = recordNumb + 1 'äëÿ áàçû âåðòèñà ïîðÿäêîâûé íîìåð
job = Left(Sheets(q).Cells(6, i).Value, 6) 'äëÿ áàçû âåðòèñà íîìåð ðàáîòû
costCode1 = Mid(Sheets(q).Cells(6, i).Value, 8, 4) 'Äâå ñîñòàâëÿþùèå cost code
costCode2 = Right(Sheets(q).Cells(6, i).Value, 5)
crew = Sheets(q).Cells(5, i).Value 'äëÿ áàçû âåðòèñà crew
Set k = Sheets(q).Range(Columns(2), Columns(4)).Rows(w)
Set l = Sheets(q).Range(Columns(8), Columns(8)).Rows(w)
Set h = Sheets(q).Range(Columns(i), Columns(i + 1)).Rows(w)
Set m = Union(k, l, h)
m.Copy
n = n + 1
Sheets(a).Select
Rows(n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(a).Range(Columns(7), Columns(8)).Select
Selection.NumberFormat = "@"
Sheets(a).Columns(17).Select
Selection.NumberFormat = "@"
Sheets(a).Columns(1).Select
Selection.NumberFormat = "@"
Sheets(a).Cells(n, "A").FormulaR1C1 = Sheets(a).Cells(n, "A").FormulaR1C1
Sheets(a).Cells(n, 7).Value = job
Sheets(a).Cells(n, 8).Value = costCode1 & costCode2
Sheets(a).Cells(n, 9).Value = crew
Sheets(a).Cells(n, 13).Value = shift
Sheets(a).Cells(n, 17).Value = timeTicket
Sheets(a).Cells(n, 18).Value = recordNumb
Case Else
If Sheets(q).Cells(w, i + 1).Value <> "" Then GoTo 15
End Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Next
2
''''''''''''''''''''''''''''''''''''''''Ïðîâåðêà íà íàëè÷èå íî÷íèêîâ íà ëèñòå(âòîðàÿ ïîëîâèíà ëèñòà)
If Sheets(q).Cells(w + 1, "E").Value Like "Ni*" Then shift = Left(Sheets(q).Cells(w + 1, "E").Value, 1)
Loop While w <> v
11
Next
6
Sheets(a).Select
'''''''''''''''''''''''''''''''''''''''''''''''''Òóïî ðàññòàíîâêà ôîðìàòîâ
Range(Cells(2, "J"), Cells(n, "O")).Select
Selection.NumberFormat = "@"
Range(Cells(2, "J"), Cells(n, "J")).Value = "V12"
Range(Cells(2, "K"), Cells(n, "K")).Value = "01"
Range(Cells(2, "L"), Cells(n, "L")).Value = "W"
Range(Cells(2, "N"), Cells(n, "N")).Value = "False"
Range(Cells(2, "O"), Cells(n, "O")).Value = "False"
Range(Cells(2, "P"), Cells(n, "P")).Value = dateReport
Range(Cells(2, "D"), Cells(n, "D")).Select
Selection.NumberFormat = "@"
Range(Cells(2, "Q"), Cells(n, "Q")).Select
Selection.NumberFormat = "@"
Range(Cells(2, "G"), Cells(n, "G")).Select
Selection.NumberFormat = "@"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''''''Ñ×ÈÒÀÅÒ ÍÅ ÎÁÛ×ÍÛÅ ËÈÑÒÛ''''''''''''''''''''''''''''''''''''
Sub Ekoshelf()
q = ActiveSheet.Index
w = 14
Do
Cells(w, "H").NumberFormat = "@" 'Ìåíÿåò ôîðìàò íà òåêñ\
Sheets(q).Cells(w, "H").FormulaR1C1 = Sheets(q).Cells(w, "H").FormulaR1C1
x = ActiveSheet.PageSetup.PrintArea
vv = Range(x).Columns.Count ' Íîìåð ïîñëåäíåãî ñòîëáöà â ëèñòå
v = Range(x).Rows.Count ' Íîìåð ïîñëåäíåé ñòðîêè â ëèñòå
For i = 10 To vv - 2 Step 2
Sheets(q).Select
kk = Sheets(q).Cells(w, "H").Value
If kk = "n/a" Then
job = Left(Sheets(q).Cells(6, i).Value, 6)
costCode1 = Mid(Sheets(q).Cells(6, i).Value, 8, 4)
costCode2 = Right(Sheets(q).Cells(6, i).Value, 5)
crew = Sheets(q).Cells(5, i).Value
shift = Left(Sheets(q).Cells(6, "E").Value, 1)
hours = Sheets(q).Cells(w, i).Value
Select Case hours
Case 1 To 24
recordNumb = recordNumb + 1
Set k = Sheets(q).Range(Columns(2), Columns(4)).Rows(w)
Set l = Sheets(q).Range(Columns(9), Columns(9)).Rows(w)
Set h = Sheets(q).Range(Columns(i), Columns(i + 1)).Rows(w)
Set m = Union(k, l, h)
m.Copy
n = n + 1
Sheets(Sheets.Count).Select
Rows(n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(Sheets.Count).Columns(8).Select
Selection.NumberFormat = "@"
Sheets(Sheets.Count).Cells(n, 7).Value = job
Sheets(Sheets.Count).Cells(n, 8).Value = costCode1 & costCode2
Sheets(Sheets.Count).Cells(n, 9).Value = crew
Sheets(Sheets.Count).Cells(n, 13).Value = shift
Sheets(Sheets.Count).Cells(n, 18).Value = recordNumb
End Select
End If
Next
w = w + 1
Loop While w <> v
End Sub
вот тупо текст макроса...где мне тут преобразовать данные заносящиеся в столбец "D", или установить формат данных в этом же столбце до копирования туда данных!!!
|
