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

Question

У меня есть серия столбцов данных, каждый 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.

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

Answer 1

Dim col As Range

For Each col In Worksheets("Sheet1").Columns
    If (col.Column > 1 And col.Column < 171) Then
    Range(col.Rows(1), col.Rows(15)).Select
    Selection.Cut
    'Select cell at bottom of A
    ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste   'Paste
    End If
Next col
End Sub

Answer 2

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

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

Answer 3

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

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

-Туарт