Страницы: 1
RSS
Перенос нескольких столбцов в новую таблицу, Из очень большой таблицы перенести конкретные столбцы
 
Добрый день.
Имеется таблица с большим количеством столбиков с данными из нее нужно переносить данные в более компактную версию, но столбики в этой версии размещены в другом порядке. Во вложении Исходная таблица и на соседнем листе вид к которому нужно ее привести.
Помогите пожалуйста, заранее СПАСИБО))
 
Светлана, из вашего примера совсем не понятен принцип (алгоритм), по которому формируется Таблица.
Задача легко решается двумя функциями: СЦЕПИТЬ и ВПР
Уважай себя, если хочешь, чтобы тебя уважали.
 
Код
Sub PssWannaCopySomeColumns()
    Application.EnableEvents = False
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = ActiveSheet
    Set sh2 = Workbooks.Add(1).Sheets(1)
    
    Dim xx As Variant
    Dim hh As Long
    For Each xx In Array(1, 7, 6, 13, 17, 15, 22, 23, 24, 35, 20)
        hh = hh + 1
        sh1.Columns(xx).Copy sh2.Cells(1, hh)
    Next
    
    Application.Calculation = Application_Calculation
    Application.EnableEvents = True
End Sub
 
Светлана Коряковская, добрый день! Вариант SQL запросом:
Код
Sub No_Dupes()
Dim myConnect As String, mySQL As String, myRecord As Object, QT As QueryTable
Dim DataRange As String, strAddress As String, wshTarget As Worksheet
    strAddress = ActiveWorkbook.Worksheets(1).Cells(1, 1).CurrentRegion.Address(0, 0)
    DataRange = "[" & ActiveWorkbook.Worksheets(1).Name & "$" & strAddress & "]"
        myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & ActiveWorkbook.FullName & ";" & _
           "Extended Properties=""Excel 12.0;HDR=YES"""
    Set myRecord = CreateObject("ADODB.Recordset")
    
    mySQL = "SELECT [1], [7], [6], [13], [17], [15], [22], [23], [24], [35], [20] FROM " & DataRange & "" ' 1, 7 и т.д. заменить на нужное имя столбца
    myRecord.Open mySQL, myConnect
    Set wshTarget = Worksheets("Лист1") ' Лист1 заменить на нужное имя листа
    With wshTarget
        .Cells.Clear
        Set QT = .QueryTables.Add(myRecord, .Range("A1"))
        QT.Refresh
        .Cells(1, 1).CurrentRegion.Columns.AutoFit
        .Cells(1, 1).CurrentRegion.Borders.Weight = xlThin
    End With
    Set QT = Nothing
    myRecord.Close
    Set myRecord = Nothing
End Sub
 
Здравствуйте, Светлана!
1.Зайдите на лист "Исходник"
2.Правой клавишей мыши выделите столбец с кастрюлями (в Вашем случае "С")
3.Нажимите "Копировать"
4.Зайдите на лист "Таблица"
5.Правой клавишей мыши выделите столбец, куда нужно вставить скопированное (в Вашем случае "B")
6.Нажимите "Вставить"
7.Повторите эти действия для оставшихся 9-и столбцов на листе "Таблица". Процесс займет не более 3-х минут (это если с попутной чашечкой кофе)  :)
Если это нужно делать часто, включите макрорекордер и повторите все эти действия для всех нужных столбцов. Получится макрос, который это будет делать за Вас, и кофе не успеет остыть :)
 
ух. сколько вариантов. И я уж, раз сделал
 
МатросНаЗебре,
Спасибо огромное, работает))))
 
Кросс с вариантом сводной таблицей
http://www.excelworld.ru/forum/2-49994-1
Скажи мне, кудесник, любимец ба’гов...
 
_Igor_61,
Спасибо за совет, если честно, я не думала о макросах, а рассчитывала на подсказку в формулах)))тк самостоятельно не получалось...
 
artemkau88,
Спасибо большое)))
 
_Boroda_, Спасибо за подсказку, буду изучать)))
 
Антон (Slash), с ВПР вот у меня и не получилось)) по одному столбцу - не вопрос, а когда их 10 и хаотично расположены... я не справилась)))
Страницы: 1
Наверх