Всем добрый день! Помогите, плиз, решить одну задачку.
Имеем книгу с несколькими листами. На листах таблицы формата [3 строки-1 столбец]. Общее кол-во строк на каждом листе может быть разным. Необходимо центрировать данные каждого столбца по 2 строке. Пример выкладываю. Пытаюсь использовать макрос типа [vba]
Код
Sub Trend_IDspot() Dim r&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets r = sh.Cells(Rows.Count, 3).End(xlUp).Row Application.ScreenUpdating = False For i = r To 3 Step -1 If sh.Cells(i, 2).Value <> "" Then sh.Cells(i, 2).Cut Destination:=sh.Cells(i + 1, 2) End If Next i For j= r To 3 Step -1 If sh.Cells(j, 3). Value <> "" Then sh.Cells(j, 3).Cut Destination:=sh.Cells(j -1, 3) End If Next j Application.ScreenUpdating = True Next End Sub
[/vba]
Если для первого столбца это еще куда не шло, то второй столбец "вылетает" капитально)) Подскажите, плиз, правильное решение
Заранее благодарен за отклик, С уважением, Алексей
Всем добрый день! Помогите, плиз, решить одну задачку.
Имеем книгу с несколькими листами. На листах таблицы формата [3 строки-1 столбец]. Общее кол-во строк на каждом листе может быть разным. Необходимо центрировать данные каждого столбца по 2 строке. Пример выкладываю. Пытаюсь использовать макрос типа [vba]
Код
Sub Trend_IDspot() Dim r&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets r = sh.Cells(Rows.Count, 3).End(xlUp).Row Application.ScreenUpdating = False For i = r To 3 Step -1 If sh.Cells(i, 2).Value <> "" Then sh.Cells(i, 2).Cut Destination:=sh.Cells(i + 1, 2) End If Next i For j= r To 3 Step -1 If sh.Cells(j, 3). Value <> "" Then sh.Cells(j, 3).Cut Destination:=sh.Cells(j -1, 3) End If Next j Application.ScreenUpdating = True Next End Sub
[/vba]
Если для первого столбца это еще куда не шло, то второй столбец "вылетает" капитально)) Подскажите, плиз, правильное решение
Заранее благодарен за отклик, С уважением, АлексейChe79
ikki, формат выгрузки такой. И пустые строки удалять ну совсем не желательно. Центровка именно по второй строке каждого квадрата таблицы С уважением
ikki, формат выгрузки такой. И пустые строки удалять ну совсем не желательно. Центровка именно по второй строке каждого квадрата таблицы С уважениемChe79
Sub Trend_IDspot() Dim r&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets r = sh.Cells(Rows.Count, 2).End(xlUp).Row rc = sh.Cells(Rows.Count, 3).End(xlUp).Row If r < rc Then r = rc Application.ScreenUpdating = False For i = 4 To r Step 3 If sh.Cells(i, 2).Offset(-1, 0) <> "" Then sh.Cells(i, 2) = sh.Cells(i, 2).Offset(-1, 0): sh.Cells(i, 2).Offset(-1, 0).ClearContents If sh.Cells(i, 2).Offset(1, 0) <> "" Then sh.Cells(i, 2) = sh.Cells(i, 2).Offset(1, 0): sh.Cells(i, 2).Offset(1, 0).ClearContents If sh.Cells(i, 3).Offset(-1, 0) <> "" Then sh.Cells(i, 3) = sh.Cells(i, 3).Offset(-1, 0): sh.Cells(i, 3).Offset(-1, 0).ClearContents If sh.Cells(i, 3).Offset(1, 0) <> "" Then sh.Cells(i, 3) = sh.Cells(i, 3).Offset(1, 0): sh.Cells(i, 3).Offset(1, 0).ClearContents Next i Application.ScreenUpdating = True Next End Sub
[/vba]
Так подойдет?
[vba]
Код
Sub Trend_IDspot() Dim r&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets r = sh.Cells(Rows.Count, 2).End(xlUp).Row rc = sh.Cells(Rows.Count, 3).End(xlUp).Row If r < rc Then r = rc Application.ScreenUpdating = False For i = 4 To r Step 3 If sh.Cells(i, 2).Offset(-1, 0) <> "" Then sh.Cells(i, 2) = sh.Cells(i, 2).Offset(-1, 0): sh.Cells(i, 2).Offset(-1, 0).ClearContents If sh.Cells(i, 2).Offset(1, 0) <> "" Then sh.Cells(i, 2) = sh.Cells(i, 2).Offset(1, 0): sh.Cells(i, 2).Offset(1, 0).ClearContents If sh.Cells(i, 3).Offset(-1, 0) <> "" Then sh.Cells(i, 3) = sh.Cells(i, 3).Offset(-1, 0): sh.Cells(i, 3).Offset(-1, 0).ClearContents If sh.Cells(i, 3).Offset(1, 0) <> "" Then sh.Cells(i, 3) = sh.Cells(i, 3).Offset(1, 0): sh.Cells(i, 3).Offset(1, 0).ClearContents Next i Application.ScreenUpdating = True Next End Sub