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

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

1 голос
/ 31 января 2011

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

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

Ответы [ 3 ]

1 голос
/ 01 февраля 2011 
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
0 голосов
/ 01 февраля 2011 
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

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

-Stuart

0 голосов
/ 01 февраля 2011

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

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
...