Visual Basic Sposta tutte le altre colonne per creare una lunga colonna B
-
27-10-2019 - |
Domanda
Ho una serie di colonne di dati, ogni 15 righe profonde. La colonna B è la colonna che voglio spostare tutte le altre colonne sotto in ordine. Quindi il contenuto della colonna C viene tagliato e spostato sotto quello già in B e così via.
Finora ho;
'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
Ho bisogno del ciclo per farlo funzionare, loop attraverso tutte le colonne da A a FN.
Grazie in anticipo.
Soluzione
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
Altri suggerimenti
Penso che questo farà quello che descrivi. In caso contrario, forse potresti spiegare un po 'più chiaramente?
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
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
Un altro approccio è usare direttamente i numeri, ma dimentico come farlo ... applausi!
-Stuart
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow