There is a table with approximately the following line structure:

 3rd value_1 3rd value_2 3rd value_3 3rd value_4 3rd value_5 3rd value_6 3rd value_7
 Value_1 Value_2
 Value_1
 Value_1 Value_2 Value_3
 3rd value_1 3rd value_2 3rd value_3 3rd value_4 3rd value_5 3rd value_6 3rd value_7
 Value_1 Value_2
 Value_1

We need to shift them to this type:

 3nachenie_1 3nachenie_2 3nachenie_3 3nachenie_4 3nachenie_5 3nachenie_6 3nachenie_7 3nachenie_1 3nachenie_2 3nachenie_1 3nachenie_1 3nachenie_2 3nachenie_3 3nachenie_1 3nachenie_2 3nachenie_3 3nachenie_4 3nachenie_5 3nachenie_6 3nachenie_7 3nachenie_1 3nachenie_2 3nachenie_1

You can manually shift, but if the lines for a thousand and more, then it will take quite a lot of time.

How to use a macro to implement such a shift?

    2 answers 2

    Somehow, without checks and restrictions:

    Sub OffsetData() Dim rRng As Range, ArrData() Dim lClmns As Long, lCnt As Long Dim bFlag As Boolean Dim i As Long, j As Long, p As Long, k As Long Set rRng = Application.InputBox("Выделить диапазон данных", "", , Type:=8) ArrData = rRng.Value: lClmns = UBound(ArrData, 2) For i = 1 To UBound(ArrData) ' по строкам k = 0: bFlag = False For j = lClmns - 1 To 1 Step -1 ' поиск первого правого значения If ArrData(i, j) <> Empty Then ' найдено первое правое значение For p = j To 1 Step -1 ' перенос значений ArrData(i, lClmns - k) = ArrData(i, p) ' переносим значение ArrData(i, p) = Empty ' удаляем значение k = k + 1: bFlag = True Next p If bFlag Then Exit For ' переходим на следующую строку End If Next j Next i rRng.Value = ArrData End Sub 
       Dim i As Integer, j As Integer Dim ws As Worksheet Dim maxColumn As Integer, valuesColumn As Integer Set ws = ThisWorkbook.Worksheets("Нужный Лист") maxColumn = ws.UsedRange.Columns.Count ' Максимальное кол-во столбцов For i = 1 To ws.UsedRange.Rows.Count ' количество столбцов со значениями в текущей строке valuesColumn = WorksheetFunction.CountA(ws.Range(ws.Rows(i).Address)) If valuesColumn < maxColumn Then For j = 1 To maxColumn - valuesColumn ws.Cells(i, 1).Insert shift:=xlToRight Next j End If Next i Set ws = Nothing
      • With UsedRange neater. UsedRange.Columns.Count will show the number of columns of the used sheet range, but not the last filled. If the data is located starting from the first column, then that's okay, it will work correctly. Another possible error: if there are other filled columns on the sheet, besides the necessary data. - vikttur pm
      • @vikttur, the presence of empty columns on the left does not affect the macro operation. And about the presence of extraneous information in the task there is not a word. - Edward Izmalkov
      • Yes, I'm not with a complaint :) So, a memory knot - vikttur
      • @vikttur, I understand, maybe my comment looks somehow harsh, but it is not. I simply answered without further ado, in case my method is useful to someone, but they will doubt after your comment. - Edward Izmalkov