ビジュアルベーシック他のすべての列を移動して1つの長い列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

別のアプローチは、数字を直接使用することですが、それを行う方法を忘れています...乾杯！

- スタート