Здравствуйте, есть первичный вид таблиц, где указана посещаемость работников на листе "Учет". Данные с этой таблицы нужно при помощи макроса(так как это будет выполнятся часто), перенести на новый лист, допустим "Для импорта"(на котором в ручную все перенесено). При помощи каких команд или функций можно подобное реализовать? В программирование немного понимаю, но конкретно язык VBA совсем не знаю. Или может у кого нибудь есть макросы с похожими задачами, буду признателен если ими поделятся. Файл Excel с первичным видом таблиц и вид таблицы после макроса прилагается.
Здравствуйте, есть первичный вид таблиц, где указана посещаемость работников на листе "Учет". Данные с этой таблицы нужно при помощи макроса(так как это будет выполнятся часто), перенести на новый лист, допустим "Для импорта"(на котором в ручную все перенесено). При помощи каких команд или функций можно подобное реализовать? В программирование немного понимаю, но конкретно язык VBA совсем не знаю. Или может у кого нибудь есть макросы с похожими задачами, буду признателен если ими поделятся. Файл Excel с первичным видом таблиц и вид таблицы после макроса прилагается.Exu
With Sheets("Учет") x = .Range("A1:AH" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Value End With ReDim y(1 To UBound(x) * 1.5, 1 To 34): k = -2
For i = 1 To UBound(x) If Len(x(i, 3)) = 4 Then k = k + 3 y(k, 1) = x(i, 1): y(k + 1, 1) = x(i, 1): y(k + 2, 1) = x(i, 1) 'ФИО y(k, 2) = x(i, 3): y(k + 1, 2) = x(i, 3): y(k + 2, 2) = x(i, 3) 'Табельный номер y(k, 3) = "Ночная": y(k + 1, 3) = "Дневная": y(k + 2, 3) = "Явка" 'Вид явки For j = 4 To UBound(x, 2) Select Case x(i, j) Case "Н": n = 0 Case "Д": n = 1 Case "Я": n = 2 Case Else: n = 100 End Select If n < 100 Then y(k + n, j) = x(i + 1, j) Next j
End If Next i
With Sheets("Для импорта") .Range("A1").CurrentRegion.Offset(1).ClearContents .Range("A2").Resize(k + 3, UBound(y, 2)).Value = y() .Activate End With End Sub
[/vba]
[p.s.]На одного писателя - 4 сторожа! С этим надо что-то делать [/p.s.]
Exu, привет попробуйте так:
[vba]
Код
Sub ertert() Dim x, y(), i&, j&, k&, n&
With Sheets("Учет") x = .Range("A1:AH" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Value End With ReDim y(1 To UBound(x) * 1.5, 1 To 34): k = -2
For i = 1 To UBound(x) If Len(x(i, 3)) = 4 Then k = k + 3 y(k, 1) = x(i, 1): y(k + 1, 1) = x(i, 1): y(k + 2, 1) = x(i, 1) 'ФИО y(k, 2) = x(i, 3): y(k + 1, 2) = x(i, 3): y(k + 2, 2) = x(i, 3) 'Табельный номер y(k, 3) = "Ночная": y(k + 1, 3) = "Дневная": y(k + 2, 3) = "Явка" 'Вид явки For j = 4 To UBound(x, 2) Select Case x(i, j) Case "Н": n = 0 Case "Д": n = 1 Case "Я": n = 2 Case Else: n = 100 End Select If n < 100 Then y(k + n, j) = x(i + 1, j) Next j
End If Next i
With Sheets("Для импорта") .Range("A1").CurrentRegion.Offset(1).ClearContents .Range("A2").Resize(k + 3, UBound(y, 2)).Value = y() .Activate End With End Sub
[/vba]
[p.s.]На одного писателя - 4 сторожа! С этим надо что-то делать [/p.s.]nilem
Sub qwerty() Dim shI As Worksheet Set shI = Sheets("Импорт") rc = 2 For x = 3 To 4 With Sheets(x) For y = 5 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2 shI.Range(Cells(rc, 1), Cells(rc + 2, 1)).Value = .Cells(y, 1).Value shI.Range(Cells(rc, 2), Cells(rc + 2, 2)).Value = .Cells(y, 3).Value shI.Cells(rc, 3).Value = "ночная" shI.Cells(rc + 1, 3).Value = "дневная" shI.Cells(rc + 2, 3).Value = "явка" For col = 4 To .Cells(4, Columns.Count).End(xlToLeft).Column Select Case .Cells(y, col).Value Case "Н" shI.Cells(rc, col).Value = .Cells(y, col).Offset(1, 0).Value Case "Д" shI.Cells(rc + 2, col).Value = .Cells(y, col).Offset(1, 0).Value Case "Я" shI.Cells(rc + 2, col).Value = .Cells(y, col).Offset(1, 0).Value End Select Next col rc = rc + 3 Next y End With Next x End Sub
[/vba]
Добрый день. сделал на "коленке" циклами
[vba]
Код
Sub qwerty() Dim shI As Worksheet Set shI = Sheets("Импорт") rc = 2 For x = 3 To 4 With Sheets(x) For y = 5 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2 shI.Range(Cells(rc, 1), Cells(rc + 2, 1)).Value = .Cells(y, 1).Value shI.Range(Cells(rc, 2), Cells(rc + 2, 2)).Value = .Cells(y, 3).Value shI.Cells(rc, 3).Value = "ночная" shI.Cells(rc + 1, 3).Value = "дневная" shI.Cells(rc + 2, 3).Value = "явка" For col = 4 To .Cells(4, Columns.Count).End(xlToLeft).Column Select Case .Cells(y, col).Value Case "Н" shI.Cells(rc, col).Value = .Cells(y, col).Offset(1, 0).Value Case "Д" shI.Cells(rc + 2, col).Value = .Cells(y, col).Offset(1, 0).Value Case "Я" shI.Cells(rc + 2, col).Value = .Cells(y, col).Offset(1, 0).Value End Select Next col rc = rc + 3 Next y End With Next x End Sub
ReDim y (1 To UBound(x) * 1.5, 1 To 34) Устанавливаем размер выходного массива: фиксируем 34 столбца. А кол-во строк задаем в 1,5 раза больше, чем есть на листе Учет k = -2 k - это просто счетчик строк в массиве
ReDim y (1 To UBound(x) * 1.5, 1 To 34) Устанавливаем размер выходного массива: фиксируем 34 столбца. А кол-во строк задаем в 1,5 раза больше, чем есть на листе Учет k = -2 k - это просто счетчик строк в массивеnilem
nilem, как можно в этот код добавить, что бы при n = 3 он копировал значение из предыдущей строки, т.к надо добавить еще 1 строку "Часы ОВ", но данные из листа в котором берем значения записаны наоборот, символ обозначающий вид стоит на нижней строке а часы стоят на верхней. Я добавил создание новой строки и добавил условие if n = 3 then y(k + n, j) = x(i - 1, j), но он наотрез отказывается добавлять значения
nilem, как можно в этот код добавить, что бы при n = 3 он копировал значение из предыдущей строки, т.к надо добавить еще 1 строку "Часы ОВ", но данные из листа в котором берем значения записаны наоборот, символ обозначающий вид стоит на нижней строке а часы стоят на верхней. Я добавил создание новой строки и добавил условие if n = 3 then y(k + n, j) = x(i - 1, j), но он наотрез отказывается добавлять значенияExu