Блог

Редактировать: я вижу, как мой пост может сбивать с толку, мне было трудно описать то, что я пытаюсь сделать.

Я хочу, чтобы конечный результат транспонирования выглядел так, как на снимке экрана. Проблема в том, почему я получаю 6 столбцов, когда мне нужно только 5. Предполагается, что значения в Col D:H являются началом и концом. Но вместо этого они смещены вправо, и Col C имеет значения, которые мне там не нужны. А также вопрос о том, почему второй ряд кажется сдвинутым вниз.

Подробнее: Первое значение в каждой группе из 5 ячеек — это серийный номер. Следующими для ячеек являются измерения. Мне нужно, чтобы эти группы по 5 человек оставались в их первоначальном порядке. Но прямо сейчас группы переходят от высокого серийного номера к низкому серийному номеру, и мне нужно, чтобы это было наоборот.

Исходное сообщение: я пытаюсь заставить каждые 5 строк переноситься в свою отдельную строку в 5 столбцах, но в обратном порядке и оставаться в порядке убывания. Первая строка в каждых 5 строках в столбце A — это серийный номер, как вы можете видеть, цифры идут по убыванию. Мне нужно сохранить 5 строк вместе, но поменять серийные номера.

Я близок, но значения в столбце D представляют собой последовательные серийные номера, которые должны быть в столбце C. И значения в столбце C кажутся последним значением в наборе из 5 строк. Может кто-нибудь, пожалуйста, помогите мне.

 My code:
Dim bottomB As Integer
bottomB = Range("A" amp; Rows.Count).End(xlUp).Row
Dim TR As Long
For TR = bottomB To 2 Step -5
Range(Cells(TR, "A"), Cells(TR   5, "A")).Copy
Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR
 

Теперь я пересмотрел ваш код, чтобы сделать то, что, как я думаю, вы намереваетесь сделать. Основное различие заключается в определении диапазона для копирования. Конечно, если вы начнете со строки 1 и добавите 5, вы окажетесь в строке 6, которая является началом следующей группы, а не концом текущей. Поэтому правильная формула заключается в определении диапазона как строк от 1 до 1 4. И если вы начнете с последней строки и добавите 4 ячейки под ней, у вас будет только одно значение в этом диапазоне, потому что все ячейки ниже последней пустые. Поэтому вы должны начать с ячейки, которая на 4 ячейки выше последней.

 ' 139
Dim bottomB As Integer
Dim TR As Long

bottomB = Range("A" amp; Rows.Count).End(xlUp).Row - 4
For TR = bottomB To 2 Step -5
    Range(Cells(TR, "A"), Cells(TR   4, "A")).Copy
    Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR
 

Я думаю, что мои корректировки устраняют ошибки, на которые вы жаловались. Однако я указываю, что код чрезмерно зависит от того, что последняя строка в столбце является четвертым измерением набора. Любое отклонение в этот момент должно привести к сбою всей операции.

Пожалуйста, рассмотрите возможность добавления Application.ScreenUpdating = False перед циклом и после этого снова установите для свойства значение True. Это значительно ускорит работу и позволит избежать мерцания на экране при быстром изменении данных.

После всего сказанного ваш код будет выглядеть следующим образом:-

 Sub TransposeRows_2()
    ' 139
    Dim bottomB As Long
    Dim TR As Long
    
    bottomB = Range("A" amp; Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For TR = (bottomB - 4) To 2 Step -5
        Range(Cells(TR, "A"), Cells(TR   4, "A")).Copy
        Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Next TR
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub
 

 Dim bottomB As Integer, b,c,d,i,j
Dim a as Collection
Dim TR As Long

Set a = New collection

bottomB = Range("A" amp; Rows.Count).End(xlUp).Row
' Put the data in a collection
For TR = bottomB To 2 Step -5
b=Range(Cells(TR, 1).Value
a.Add b.value
Next TR

Calculate 1/5th of total items in collection
c=Round((a.count)/5)
d=0

' You'll have to specify the start positions you want to paste
For i= Row1 to Row1 c
For j= Column1 to Column5

' Paste collection into cells
Worksheets("").Cells(i,j).Value=a(d)
d=d 1
Next i
Next j