VBA: вырезать ряд столбцов и вставлять их как один столбец

Я довольно новый и очень ценю вашу помощь. У меня есть данные в 14000 столбцов, каждая по 30 строк.

Мне нужно вставить каждый столбец под друг другом, чтобы у меня остался только один столбец. Я привел пример скриншота:

Пример данных

Моя попытка кода VBA выглядит следующим образом (что не работает):

Sub Cut() Dim i As Integer For i = 1 To 14000 Col = Columns(i).Select Range("N2:N31").Offset(, i).Select Selection.Cut Range("H2").End(xlDown).Offset(1).Row.Select ActiveSheet.Paste Next i End Sub 

Пожалуйста помоги. благодаря

Вместо диапазона копирования вы можете просто присвоить значения диапазону, как

 Sub ConvertRangeToColumn() Dim ws As Worksheet Dim lastColumn As Long, lastRow As Long Dim rng As Range Application.ScreenUpdating = False Set ws = ThisWorkbook.Sheets("Sheet1") 'change Sheet1 to yout data sheet With ws lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column 'get last column using Row 1 For i = 5 To lastColumn 'loop though each column starting from 5 Set rng = .Range(.Cells(2, i), .Cells(.Cells(.Rows.Count, i).End(xlUp).Row, i)) 'set range to copy .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).Resize(rng.Rows.Count).Value = rng.Value Next i End With Application.ScreenUpdating = True End Sub 

Попробуйте это, что предполагает, что ваши данные начинаются в строке 1.

 Sub Cut() Dim c As Long Application.screenupdating=false For c = 14 To Cells(1, Columns.Count).End(xlToLeft).Column 'change 1 if data starts in a different row Range(Cells(1, c), Cells(Rows.Count, c).End(xlUp)).Copy Range("A" & Rows.Count).End(xlUp)(2) Next c Application.screenupdating=true End Sub 

Специально для больших объемов данных вам часто будет лучше (более быстрое время выполнения), читая исходные данные в массив VBA; манипулирование им; затем записывая его обратно на рабочий лист, по сравнению с несколькими чтениями / записью на рабочий лист.

Вот пример использования этой несколько другой техники для ваших данных, если я правильно понимаю вашу настройку данных (непрерывный диапазон данных, включая N2 , без пробелов и всех столбцов одинаковой длины). Если мое понимание настройки данных неверно, возможно, потребуются незначительные изменения кода.

Кроме того, это может не работать в 32-разрядном Excel, но стоит попробовать.

 Option Explicit Sub ManyIntoOneColumn() Dim WS As Worksheet Dim rWhatIHave As Range Dim rWhatIWant As Range Dim V As Variant, W As Variant Dim I As Long, J As Long, K As Long 'set worksheet Set WS = Worksheets("sheet1") 'change worksheet name 'set range to copy. If not contiguous, might have to do it differently Set rWhatIHave = WS.Range("N2").CurrentRegion 'set first cell of WhatIWant Set rWhatIWant = WS.Range("H2") 'read range into variant array V = rWhatIHave 'dimension results array ReDim W(1 To UBound(V, 1) * UBound(V, 2), 1 To 1) 'populate W K = 0 For I = 1 To UBound(V, 2) For J = 1 To UBound(V, 1) K = K + 1 W(K, 1) = V(J, I) Next J Next I 'set rWhatIWant Set rWhatIWant = rWhatIWant.Resize(rowsize:=UBound(W, 1), columnsize:=1) 'clear results range and write the values With rWhatIWant .EntireColumn.Clear .Value = W .EntireColumn.AutoFit End With End Sub 

Он будет выглядеть примерно так:

 Option Explicit Sub MoveData() Dim i As Long, lRowData As Long, lRowInput As Long ' "H" is 8th column, so you might want ' to change starting value of i to 9 or something like that For i = 14 To 14000 ' Last row in "H" column (where you paste data) lRowInput = Range("H" & ActiveSheet.Rows.Count).End(xlUp).Row ' Last row in i column (from where you draw data) lRowData = Cells(ActiveSheet.Rows.Count, i).End(xlUp).Row ' Copy values from i column to "H" column Range("H" & lRowInput + 1, "H" & lRowInput + lRowData - 1) = _ Range(Cells(2, i), Cells(lRowData, i)).Value Next i End Sub 
Interesting Posts

Выделите ключевое слово using openpyxl

определить событие с четным значением в PivotTableAfterValueChange

Преобразование текстового файла в excel с разделителями и текстовыми колонками vbscript

Excel Userform Textbox Constant Set Focus

Вставить строку в excel

Python pandas, Как я могу прочитать файл excel без метки столбца, а затем вставить метку столбца?

Как не показывать данные в сводной таблице

Лучший способ импортировать числовые и нечисловые данные (строки) из файла excel в MATLAB?

Excel: как скопировать часть содержимого ячеек в другие смежные ячейки на соответствующих строках

vba показать пользовательскую форму при открытии, скрыть рабочий лист, но сохранить значок панели задач

Повторное использование кода Spreadhseet

Метод PasteSpecial по диапазону не работает

Excel VBA Loop через часть листов по списку имен

excel vba macro: скопируйте и вставьте конкретный столбец в другую книгу

Excel: форматирование стоп-ячеек применяется к соседней ячейке?

Давайте будем гением компьютера.