Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенос значений с нескольких столбцов в один столбец - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенос значений с нескольких столбцов в один столбец (Формулы/Formulas)
Перенос значений с нескольких столбцов в один столбец
diooniss Дата: Пятница, 05.08.2022, 10:05 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Добрый день. Помогите пожалуйста сделать формулу или предложите другое решение. Есть таблица ABCDEFG столбцы и рядом H столбец. необходимо когда вставляют номера телефонов в столбцы ABCDEFG или только ABC чтобы в столбце H номера переносились по порядку с начало с А столбца потом В итд. В столбце Н должны идти номера без пропуску строк. Нашел решение с помощью Kutools диапазон переноса до одного столбца. Но он переносит построчно что не подходит.
К сообщению приложен файл: 3458492.xlsx (10.1 Kb)
 
Ответить
СообщениеДобрый день. Помогите пожалуйста сделать формулу или предложите другое решение. Есть таблица ABCDEFG столбцы и рядом H столбец. необходимо когда вставляют номера телефонов в столбцы ABCDEFG или только ABC чтобы в столбце H номера переносились по порядку с начало с А столбца потом В итд. В столбце Н должны идти номера без пропуску строк. Нашел решение с помощью Kutools диапазон переноса до одного столбца. Но он переносит построчно что не подходит.
Автор - diooniss
Дата добавления - 05.08.2022 в 10:05
Nic70y Дата: Пятница, 05.08.2022, 11:36 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 9006
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
вдруг правильно
[vba]
Код
Sub u_625()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    For u = 1 To a
        For Each v In Range("a" & u & ":f" & u)
            If v.Value <> "" Then
                b = Cells(Rows.Count, "h").End(xlUp).Row + 1
                v.Copy Range("h" & b)
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 14.xlsm (17.7 Kb)

ЮMoney 41001841029809
 
Ответить
Сообщениевдруг правильно
[vba]
Код
Sub u_625()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    For u = 1 To a
        For Each v In Range("a" & u & ":f" & u)
            If v.Value <> "" Then
                b = Cells(Rows.Count, "h").End(xlUp).Row + 1
                v.Copy Range("h" & b)
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - Nic70y
Дата добавления - 05.08.2022 в 11:36
diooniss Дата: Пятница, 05.08.2022, 11:43 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Цитата Nic70y, 05.08.2022 в 11:36, в сообщении № 2 ()
вдруг правильно

Спасибо хоть кто-то откликнулся. Не не то. Получается что данные заносятся построчно а надо по порядку столбцов.
 
Ответить
Сообщение
Цитата Nic70y, 05.08.2022 в 11:36, в сообщении № 2 ()
вдруг правильно

Спасибо хоть кто-то откликнулся. Не не то. Получается что данные заносятся построчно а надо по порядку столбцов.
Автор - diooniss
Дата добавления - 05.08.2022 в 11:43
Nic70y Дата: Пятница, 05.08.2022, 11:51 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 9006
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
Цитата diooniss, 05.08.2022 в 11:43, в сообщении № 3 ()
Не не то
какие Ваши доказательства? (с)

ЮMoney 41001841029809
 
Ответить
Сообщение
Цитата diooniss, 05.08.2022 в 11:43, в сообщении № 3 ()
Не не то
какие Ваши доказательства? (с)
Автор - Nic70y
Дата добавления - 05.08.2022 в 11:51
msi2102 Дата: Пятница, 05.08.2022, 12:01 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Если есть эти функции, то можно так
[vba]
Код
=ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(ОБЪЕДИНИТЬ(";";1;ТРАНСП(A1:F3));";";"</s><s>")&"</s></t>";"//s")
[/vba]
К сообщению приложен файл: 5457283.xlsx (11.6 Kb)
 
Ответить
СообщениеЕсли есть эти функции, то можно так
[vba]
Код
=ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(ОБЪЕДИНИТЬ(";";1;ТРАНСП(A1:F3));";";"</s><s>")&"</s></t>";"//s")
[/vba]
Автор - msi2102
Дата добавления - 05.08.2022 в 12:01
msi2102 Дата: Пятница, 05.08.2022, 12:15 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Цитата Nic70y, 05.08.2022 в 11:51, в сообщении № 4 ()
какие Ваши доказательства?

Наверное ТС просто хочет так :D
[vba]
Код
Sub u_626()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    arr1 = Range("A1:F" & a)
    ReDim arr2(1 To UBound(arr1) * UBound(arr1, 2), 1 To 1)
    n = 1
    For u = 1 To UBound(arr1, 2)
        For v = 1 To UBound(arr1)
            If arr1(v, u) <> "" Then
                arr2(n, 1) = arr1(v, u)
                n = n + 1
            End If
        Next
    Next
    [h1].Resize(UBound(arr2), 1) = arr2
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 8399314.xlsm (19.5 Kb)


Сообщение отредактировал msi2102 - Пятница, 05.08.2022, 12:21
 
Ответить
Сообщение
Цитата Nic70y, 05.08.2022 в 11:51, в сообщении № 4 ()
какие Ваши доказательства?

Наверное ТС просто хочет так :D
[vba]
Код
Sub u_626()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    arr1 = Range("A1:F" & a)
    ReDim arr2(1 To UBound(arr1) * UBound(arr1, 2), 1 To 1)
    n = 1
    For u = 1 To UBound(arr1, 2)
        For v = 1 To UBound(arr1)
            If arr1(v, u) <> "" Then
                arr2(n, 1) = arr1(v, u)
                n = n + 1
            End If
        Next
    Next
    [h1].Resize(UBound(arr2), 1) = arr2
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - msi2102
Дата добавления - 05.08.2022 в 12:15
diooniss Дата: Пятница, 05.08.2022, 12:25 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Цитата msi2102, 05.08.2022 в 12:15, в сообщении № 6 ()
Наверное ТС просто хочет так

Огромное спасибо именно так. Хорошего дня и прекрасного вечера!!! сегодня пятница ура!!!
 
Ответить
Сообщение
Цитата msi2102, 05.08.2022 в 12:15, в сообщении № 6 ()
Наверное ТС просто хочет так

Огромное спасибо именно так. Хорошего дня и прекрасного вечера!!! сегодня пятница ура!!!
Автор - diooniss
Дата добавления - 05.08.2022 в 12:25
jakim Дата: Пятница, 05.08.2022, 12:50 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1216
Репутация: 316 ±
Замечаний: 0% ±

Excel 2010
Power Query

[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table47"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type number}, {"Column2", type number}, {"Column3", type number}, {"Column4", type number}, {"Column5", type number}, {"Column6", type number}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
    #"Removed Columns
[/vba]
К сообщению приложен файл: 6908875.xlsx (16.1 Kb)
 
Ответить
Сообщение
Power Query

[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table47"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type number}, {"Column2", type number}, {"Column3", type number}, {"Column4", type number}, {"Column5", type number}, {"Column6", type number}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
    #"Removed Columns
[/vba]
Автор - jakim
Дата добавления - 05.08.2022 в 12:50
Nic70y Дата: Пятница, 05.08.2022, 12:53 | Сообщение № 9
Группа: Друзья
Ранг: Экселист
Сообщений: 9006
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
Цитата msi2102, 05.08.2022 в 12:15, в сообщении № 6 ()
Наверное ТС просто хочет так
ну так бы сразу и сказали)
[vba]
Код
Sub u_627()
    Application.ScreenUpdating = False
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    For u = 1 To 6
        f = Cells(Rows.Count, u).End(xlUp).Row
        x = Cells(Rows.Count, "h").End(xlUp).Row + 1
        Range(Cells(1, u), Cells(f, u)).Copy Range("h" & x)
    Next
    y = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & y).SpecialCells(xlCellTypeBlanks).Delete
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 15.xlsm (18.4 Kb)

ЮMoney 41001841029809
 
Ответить
Сообщение
Цитата msi2102, 05.08.2022 в 12:15, в сообщении № 6 ()
Наверное ТС просто хочет так
ну так бы сразу и сказали)
[vba]
Код
Sub u_627()
    Application.ScreenUpdating = False
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    For u = 1 To 6
        f = Cells(Rows.Count, u).End(xlUp).Row
        x = Cells(Rows.Count, "h").End(xlUp).Row + 1
        Range(Cells(1, u), Cells(f, u)).Copy Range("h" & x)
    Next
    y = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & y).SpecialCells(xlCellTypeBlanks).Delete
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - Nic70y
Дата добавления - 05.08.2022 в 12:53
jakim Дата: Пятница, 05.08.2022, 13:16 | Сообщение № 10
Группа: Друзья
Ранг: Старожил
Сообщений: 1216
Репутация: 316 ±
Замечаний: 0% ±

Excel 2010
Вариант с формулой

Код
=INDEX($A$1:$F$21;CEILING(ROWS($1:1)/COUNTA($A$1:$F$1);1);MOD(ROWS($1:1)-1;COUNTA($A$1:$F$1))+1)
К сообщению приложен файл: 3458492-1-.xlsx (10.7 Kb)
 
Ответить
Сообщение
Вариант с формулой

Код
=INDEX($A$1:$F$21;CEILING(ROWS($1:1)/COUNTA($A$1:$F$1);1);MOD(ROWS($1:1)-1;COUNTA($A$1:$F$1))+1)
Автор - jakim
Дата добавления - 05.08.2022 в 13:16
diooniss Дата: Пятница, 05.08.2022, 15:24 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

msi2102, Дорогой а сделай пожалуйста тоже самое только чтобы формат ячеек был числовой, число десятичных знаков 0.За ранее спасибо.
 
Ответить
Сообщениеmsi2102, Дорогой а сделай пожалуйста тоже самое только чтобы формат ячеек был числовой, число десятичных знаков 0.За ранее спасибо.
Автор - diooniss
Дата добавления - 05.08.2022 в 15:24
msi2102 Дата: Пятница, 05.08.2022, 15:59 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Не совсем понял, что именно Вы хотите, по сути там общий формат и Excel его вполне понимает как число, но если очень нужно, то так
[vba]
Код
Sub u_626()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    arr1 = Range("A1:F" & a)
    ReDim arr2(1 To UBound(arr1) * UBound(arr1, 2), 1 To 1)
    n = 1
    For u = 1 To UBound(arr1, 2)
        For v = 1 To UBound(arr1)
            If arr1(v, u) <> "" Then
                arr2(n, 1) = arr1(v, u)
                n = n + 1
            End If
        Next
    Next
    [h1].Resize(UBound(arr2), 1).NumberFormat = "0"
    [h1].Resize(UBound(arr2), 1) = arr2
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 0546962.xlsm (20.0 Kb)


Сообщение отредактировал msi2102 - Пятница, 05.08.2022, 16:01
 
Ответить
СообщениеНе совсем понял, что именно Вы хотите, по сути там общий формат и Excel его вполне понимает как число, но если очень нужно, то так
[vba]
Код
Sub u_626()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    c = Cells(Rows.Count, "h").End(xlUp).Row
    Range("h1:h" & c).Clear
    arr1 = Range("A1:F" & a)
    ReDim arr2(1 To UBound(arr1) * UBound(arr1, 2), 1 To 1)
    n = 1
    For u = 1 To UBound(arr1, 2)
        For v = 1 To UBound(arr1)
            If arr1(v, u) <> "" Then
                arr2(n, 1) = arr1(v, u)
                n = n + 1
            End If
        Next
    Next
    [h1].Resize(UBound(arr2), 1).NumberFormat = "0"
    [h1].Resize(UBound(arr2), 1) = arr2
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - msi2102
Дата добавления - 05.08.2022 в 15:59
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенос значений с нескольких столбцов в один столбец (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!