Visual Basic перемещает все остальные столбцы, чтобы создать один длинный столбец B

У меня есть ряд столбцов данных, каждый из которых имеет глубину 15 строк. Столбец B — это столбец, в который я хочу переместить все остальные столбцы по порядку. Таким образом, содержимое столбца C обрезается и перемещается ниже того, что уже находится в B, и так далее.

До сих пор у меня есть;

'Select a column
ActiveSheet.Range("B1", ActiveSheet.Range("B1").End(xlDown)).Select
'Cut
Selection.Cut
'Select cell at bottom of A
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
'Paste
ActiveSheet.Paste

Мне нужен цикл, чтобы заставить его работать, перебирая все столбцы от A до FN.

Заранее спасибо.


excel vba excel-2010
person mhollander38    schedule 31.01.2011    source источник
comment
Извините, я не понимаю.... Вы хотите переместить ЧТО под ЧТО?   -  person Dr. belisarius    schedule 01.02.2011
comment
Все остальные столбцы в столбце B. Таким образом, данные столбца C в столбце B, данные столбца D в столбце B и т. д. вплоть до столбца FN, поэтому у меня остался один длинный столбец B.   -  person mhollander38    schedule 01.02.2011
comment
Позвольте мне поприветствовать вас на StackOverflow и напомнить три вещи, которые мы обычно здесь делаем: 1) Когда вы получаете помощь, старайтесь также оказывать ее, отвечая на вопросы в вашей области знаний 2) Read the FAQs 3) Когда вы увидите хорошие вопросы и ответы, проголосуйте за нихusing the gray triangles, так как доверие к системе основано на репутации, которую пользователи получают, делясь своими знаниями. Также не забудьте принять ответ, который лучше решает вашу проблему, если таковой имеется, by pressing the checkmark sign   -  person Dr. belisarius    schedule 01.02.2011

Ответы (2)


arrow_upward
0
arrow_downward

Я думаю, что это будет делать то, что вы описываете. Если нет, возможно, вы могли бы объяснить немного яснее?

Dim LastCol As Integer, c As Integer, r As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 2 To LastCol
        If Cells(1, c) <> "" Then
            ActiveSheet.Range(Chr$(64 + c) & "1", ActiveSheet.Range(Chr$(64 + c) & "1").End(xlDown)).Select
            Selection.Cut
            ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
        End If
Next c

person lowlevel    schedule 31.01.2011
comment
Это вызывает ошибку времени выполнения 1004 для; ActiveSheet.Range(Chr$(64 + c) & 1, ActiveSheet.Range(Chr$(64 + c) & 1).End(xlDown)).Select Он также поднимается только до строки Z, мне это нужно в столбец FN или, в идеале, в последний столбец, содержащий данные. - person mhollander38; 01.02.2011
comment
В этом примере просто требуется, чтобы в каждой ячейке в верхней части электронной таблицы было что-то, чтобы продолжать добавлять данные столбца в столбец A. Вы должны иметь возможность заставить его делать то, что хотите, из этого примера... но да, вам потребуется это пройти мимо столбца Z, что означает несколько иной подход к прохождению столбцов. - person lowlevel; 01.02.2011
comment
Я добавлю еще один ответ через минуту, и он будет работать для столбца FN, если хотите... - person lowlevel; 01.02.2011
comment
Добро пожаловать, это отличное сообщество, и у меня было время убить, так почему бы и нет! Заботиться - person lowlevel; 01.02.2011

arrow_upward
0
arrow_downward 

Sub go()
Dim LastCol As Integer, c As Integer, r As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 2 To LastCol
        If Cells(1, c)  "" Then
            ActiveSheet.Range(ColumnLetter(c) & "1", ActiveSheet.Range(ColumnLetter(c) & "1").End(xlDown)).Select
            Selection.Cut
            ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
        End If
Next c

End Sub

Function ColumnLetter(ColumnNumber As Integer) As String
  If ColumnNumber > 26 Then

    ' 1st character:  Subtract 1 to map the characters to 0-25,
    '                 but you don't have to remap back to 1-26
    '                 after the 'Int' operation since columns
    '                 1-26 have no prefix letter

    ' 2nd character:  Subtract 1 to map the characters to 0-25,
    '                 but then must remap back to 1-26 after
    '                 the 'Mod' operation by adding 1 back in
    '                 (included in the '65')

    ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                   Chr(((ColumnNumber - 1) Mod 26) + 65)
  Else
    ' Columns A-Z
    ColumnLetter = Chr(ColumnNumber + 64)
  End If
End Function

Другой подход - использовать числа напрямую, но я забыл, как это сделать... Ура!

-Стюарт

person lowlevel    schedule 31.01.2011