Добрый вечер! Помогите разбить 1 столбец на 5. Изготовитель1 Заказчик1 Заказ1 Сумма1 Дата1 Изготовитель2 Заказчик2 Заказ2 Сумма2 Дата2 Должен быть вид конечной таблицы(шапка) Изготовитель Заказчик Заказ Сумма Дата Нашла интересный код у вас на сайте, который подходит и работает, но проблема в том, что "Изготовитель,Заказчик и заказ оформлены в виде гиперссылки, а сумма и дата в виде текста. Хотелось бы формат сохранить, но данный код делает все, кроме 1 столбца текстом. Код таков: [vba]
Код
Sub Макрос() Dim i As Long, r As Long, n As Variant n = InputBox("Введите количество столбцов," & Chr(10) & "на которое разбить столбец А", _ "Ввод количества столбцов", 5) If n <> "" Then Application.ScreenUpdating = False Dim MyArray As Variant, CArray() ' As Long r = Int(1 + Columns(1).End(xlDown).Row / n) ReDim CArray(1 To r, 1 To n) MyArray = Range("A1:A" & Columns(1).End(xlDown).Row).Value For i = 1 To UBound(MyArray) CArray(Int((i + n - 1) / n), ((i - 1) Mod n) + 1) = MyArray(i, 1) Next i Range("A1:A" & Columns(1).End(xlDown).Row).ClearContents Range("A1").Resize(r, n) = CArray() Application.ScreenUpdating = True End If End Sub
[/vba]
Добрый вечер! Помогите разбить 1 столбец на 5. Изготовитель1 Заказчик1 Заказ1 Сумма1 Дата1 Изготовитель2 Заказчик2 Заказ2 Сумма2 Дата2 Должен быть вид конечной таблицы(шапка) Изготовитель Заказчик Заказ Сумма Дата Нашла интересный код у вас на сайте, который подходит и работает, но проблема в том, что "Изготовитель,Заказчик и заказ оформлены в виде гиперссылки, а сумма и дата в виде текста. Хотелось бы формат сохранить, но данный код делает все, кроме 1 столбца текстом. Код таков: [vba]
Код
Sub Макрос() Dim i As Long, r As Long, n As Variant n = InputBox("Введите количество столбцов," & Chr(10) & "на которое разбить столбец А", _ "Ввод количества столбцов", 5) If n <> "" Then Application.ScreenUpdating = False Dim MyArray As Variant, CArray() ' As Long r = Int(1 + Columns(1).End(xlDown).Row / n) ReDim CArray(1 To r, 1 To n) MyArray = Range("A1:A" & Columns(1).End(xlDown).Row).Value For i = 1 To UBound(MyArray) CArray(Int((i + n - 1) / n), ((i - 1) Mod n) + 1) = MyArray(i, 1) Next i Range("A1:A" & Columns(1).End(xlDown).Row).ClearContents Range("A1").Resize(r, n) = CArray() Application.ScreenUpdating = True End If End Sub
а сумма и дата в виде текста. Хотелось бы формат сохранить, но данный код делает все, кроме 1 столбца текстом.
В вашем примере не видно вообще никаких данных. Вы хотите, что бы мы помогли превратить слова "Сумма" и "Дата" в значения? Не получится! Ну откуда нам знать в каком они у вас виде и формате в оригинале! Лично я не телепат. Да и многие участники форума жалуются на отсутствие телепатии.
а сумма и дата в виде текста. Хотелось бы формат сохранить, но данный код делает все, кроме 1 столбца текстом.
В вашем примере не видно вообще никаких данных. Вы хотите, что бы мы помогли превратить слова "Сумма" и "Дата" в значения? Не получится! Ну откуда нам знать в каком они у вас виде и формате в оригинале! Лично я не телепат. Да и многие участники форума жалуются на отсутствие телепатии. Wasilich