Страницы: 1
RSS
Перенос данных по имени столбца
 
Добрый день!
Друзья, возник вопрос переноса данных их одного листа на другой.
Есть при проблемы:
1. Есть строки с данными
2. Есть столбы с данными
3. Все перемещается по документу, нет точных значений ячеек.
Во вложении пример, как это выглядит в сокращенном варианте.

В общем весь вопрос состоит в том, как перенести данные по названию заголовков столбцов и строк, если все еще перемещается по литу и не имеет точных ячеек.
Может кто сможет помочь с маленьким примером.
Код
 
Цитата
occupiedwork написал:
Все перемещается по документу
что это значит? сейчас дата начала на листе1 стоит в А2 а потом где она может быть в любом другом месте например в XFC1048574?
Лень двигатель прогресса, доказано!!!
 
Диапазон не настолько большой, но она может быть к примеру в А10 или С13. Может меняться порядок, сначала дата окончания, потом дата начала. Я думал искать столбец или строку по названию ячейки и как-то переносить потом данные этого столбца или строки на другой лист
Код
Sheets("Дата начала").Select
For y = 1 To Cells.SpecialCells(xlLastCell).Row
    If Cells(y, 1) = "123" Then
        Exit For
    End If
 
Можно со второго столбца брать названия полей (заголовки) в массив, потом в источнике искать по каждому значению массива и переносить данные. В примере указаны 3 названия столбцов, при которых данные расположены горизонтально. Это всегда так? Или их может быть больше/меньше?

З.Ы. заодно - первая группа (там где данные горизонтально) от второй группы - всегда отделена пустыми строками/столбцами, или могут соприкасаться? всегда ли первая группа "выше" на листе, чем вторая?
Изменено: Пытливый - 08.11.2019 15:49:21
Кому решение нужно - тот пример и рисует.
 
А можно просто дать имена нужным полям и на них опереться
Если будет другой источник то незначительная коррекция все исправит.
По вопросам из тем форума, личку не читаю.
 
Можно со второго столбца брать названия полей (заголовки) в массив, потом в источнике искать по каждому значению массива и переносить данные.
В примере указаны 3 названия столбцов, при которых данные расположены горизонтально. Это всегда так? Или их может быть больше/меньше? - да все верно, их может быть как больше так и меньше, пока нет точного числа на сколько, но в приделах 10 горизонтальных.

З.Ы. заодно - первая группа (там где данные горизонтально) от второй группы - всегда отделена пустыми строками/столбцами, или могут соприкасаться? всегда ли первая группа "выше" на листе, чем вторая? - первая группа всегда выше, в 90% есть пустые строки между ними как в примере.

А можно просто дать имена нужным полям и на них опереться
Если будет другой источник то незначительная коррекция все исправит. - файлы каждый раз приходят от разных людей, файл заранее нельзя отредактировать и предоставить, они сами берут его с ресурса. В общем файл уже есть как есть без имен, каждый раз придется все заново вязать.

Так как на втором листе ничего не меняется, там будет четкий порядок по столбцам, все на своих местах, думаю попробую найти как сделать, чтобы:
1. Найти ячейку с именем столба/строки
2. Копировать строку/столбец до последней заполнено
3. Вставка на новый лист, на свое место
 
Ссылка на похожую тему: http://www.excelworld.ru/forum/10-43424-1#287343
Код
Option Explicit

Function Шапку_С_Таблицей_в_БД()

' Позволяет таблицы с отдельными шапками собирать в базу данных

A2_2_Range _
    ArrayDim2_Set_ArrayDim2_Horizont_Right( _
    ArrayDim2_FillDown(ArrayDim2_Row_1, UBound(ArrayDim2_Rows)), _
    ArrayDim2_Rows), Лист1.Cells(2, 7)

End Function

Function ArrayDim2_Set_ArrayDim2_Horizont_Right( _
a2_Left_() As Variant, _
a2_Right() As Variant) _
As Variant()
' test yes
'массив приставить к массиву горизонтально справа

Dim width_New As Long
width_New = UBound(a2_Left_, 2) + UBound(a2_Right, 2)

Dim a2_New() As Variant
a2_New = a2_Left_

ReDim Preserve a2_New(1 To UBound(a2_New), _
    1 To width_New)

Dim lRow As Long, _
    lCol As Long, _
    diff_Column As Long
    
diff_Column = LBound(a2_New, 2)
        
For lRow = LBound(a2_New) To UBound(a2_New)
                    
    For lCol = UBound(a2_Left_, 2) + 1 To width_New
                    
    a2_New(lRow, lCol) = a2_Right( _
        lRow, lCol - diff_Column)
                    
    Next lCol
Next lRow
                    
ArrayDim2_Set_ArrayDim2_Horizont_Right = a2_New
        
End Function

Function ArrayDim2_Row_1() _
As Variant()

Dim a2() As Variant

With Лист1

    a2 = .Range( _
    .Cells(2, 2), .Cells(4, 2)).Value

End With

ArrayDim2_Row_1 = ArrayDim2_Transpose(a2)

End Function

Function ArrayDim2_FillDown( _
a2() As Variant, _
rows_Max As Long) _
As Variant()
' test yes
' однострочный массив протянуть вниз, _
' строку первую копировать в каждую

Dim a2_New() As Variant
ReDim a2_New(1 To rows_Max, 1 To UBound(a2))

Dim lRow As Long, _
    lCol As Long
    
For lRow = LBound(a2_New) To UBound(a2_New)

    For lCol = LBound(a2_New, 2) To UBound(a2_New, 2)
    
    a2_New(lRow, lCol) = a2(1, lCol)
    
    Next lCol
Next lRow

ArrayDim2_FillDown = a2_New

End Function

Function ArrayDim2_Rows() _
As Variant()

With Лист1
    
    ArrayDim2_Rows = .Range( _
    .Cells(7, 2), .Cells(16, 4)).Value
    
End With
End Function

Function ArrayDim2_Transpose( _
a2() As Variant) _
As Variant()

' массив двумерный транспонирование

Dim a2_Temp() As Variant, _
    x As Long, _
    y As Long
    
ReDim a2_Temp( _
    LBound(a2, 2) To UBound(a2, 2), _
    LBound(a2, 1) To UBound(a2, 1))
    
For x = LBound(a2, 2) To UBound(a2, 2)
        
    For y = LBound(a2, 1) To UBound(a2, 1)
            
    a2_Temp(x, y) = a2(y, x)
        
    Next y
Next x

ArrayDim2_Transpose = a2_Temp

End Function

Sub A2_2_Range( _
        a2() As Variant, _
        ceLL As Range)
    ' Test Covered
    ceLL.Resize( _
            UBound(a2), UBound(a2, 2)).Value = _
            a2

End Sub
Изменено: occupiedwork - 15.11.2019 14:05:32
 
Цитата
occupiedwork написал:
На другом форуме дали вот это
сами палитесь. надо давать ссылки на другие ресурсы. В правилах сие есть.

Цитата
occupiedwork написал:
каждый раз придется все заново вязать
вопрос сколько таких вязанок надо сделать. Конечно автоматически все сделать - это желаемый результат, но если это только lj 10 имен то глазами может быстрее и без ошибок получится?
Изменено: БМВ - 08.11.2019 18:12:51
По вопросам из тем форума, личку не читаю.
 
Дело не в количестве самих данных, а в количестве файлов. Порой их число доходит до 1000 штук в день. На данный момент все переносится вручную и просматривается глазами, то еще занятие я вам скажу))  
 
Цитата
БМВ написал: надо давать ссылки на другие ресурсы
occupiedwork, где Вы показали ссылку?
Страницы: 1
Наверх