Страницы: 1
RSS
Как аккумулировать данные в одну строку
 
Очень прошу помочь в решении проблемы: есть файл, в котором данные по одному объекту находятся в нескольких строках(от 2 до 10 строк). Необходимо собрать всю информацию в одной строке, при этом, если в исходной (первой) строке уже информация есть, то ее не менять.  
 
в код листа:
Код
Sub ИванИваныч()
On Error Resume Next
With [a3:h9]
For i = 1 To 8
Cells(16, i) = .Columns(i).SpecialCells(2).Value
Next
End With
End Sub
 
у меня формулой получилось
=ИНДЕКС(B3:B9;ПОИСКПОЗ("***";B3:B9;0)) и протянуть вправо
 
Спасибо всем, кто откликнулся, но проблема несколько больше: в файле информация не по одному человеку, а порядка 10 тысяч. Как в этом случае лучше построить цикл?
Изменено: shoa - 18.12.2015 23:12:14 (добавила файл)
 
Цитата
shoa написал:
порядка 10 тысяч
Могли бы дать больше информации в свежем примере - структура данных непонятна.
Макрос, который работает с данными из первого примера. Результат на новом листе. Предполагается, что в первой строке заголовок.
Код
Sub Shoa()
Dim v(), i&, res&, col&, ii&, st&
'i - счетчик исходных строк
'res - счетчик строк результата
'st - номер строки начала группы
'ii - счетчик строк внутри группы
'col - счетчик столбцов
  
  v = ActiveSheet.UsedRange.Offset(1).Value 'массив значений начиная с 2 строки, включая пустую строку в конце
  st = 1
  For i = 2 To UBound(v)
    If v(i, 1) <> v(st, 1) Then
      res = res + 1
      v(res, 1) = v(st, 1)
      For col = 2 To UBound(v, 2)
        For ii = st To i - 1
          If Not IsEmpty(v(ii, col)) Then
            v(res, col) = v(ii, col)
            Exit For
          End If
        Next
      Next
      st = i
    End If
  Next
  Worksheets.Add.Range("A2").Resize(res, col - 1).Value = v
End Sub
 
Формулой для 2010 офиса.
 
Огромное спасибо за помощь
 
Сообщение от ТС:
Цитата
Если по клиенту только одна запись, то строка формируется неверно
Дело не в кол-ве записей, хотя Вы писали
Цитата
shoa написал:
данные по одному объекту находятся в нескольких строках(от 2 до 10 строк)
, а в том, что если во всем столбце по объекту пусто, то в результирующую строку ничего не переносится, и там остаются данные от другого объекта.
Добавил очистку элемента массива в этом случае.
Код
Sub Shoa()
Dim v(), i&, res&, col&, ii&, st&
'i - счетчик исходных строк
'res - счетчик строк результата
'st - номер строки начала группы
'ii - счетчик строк внутри группы
'col - счетчик столбцов
  
  v = ActiveSheet.UsedRange.Offset(1).Value 'массив значений начиная с 2 строки, включая пустую строку в конце
  st = 1
  For i = 2 To UBound(v)
    If v(i, 1) <> v(st, 1) Then
      res = res + 1
      v(res, 1) = v(st, 1)
      For col = 2 To UBound(v, 2)
        Do
        For ii = st To i - 1
          If Not IsEmpty(v(ii, col)) Then
            v(res, col) = v(ii, col)
            Exit Do
          End If
        Next
        v(res, col) = Empty
        Loop Until True
      Next
      st = i
    End If
  Next
  Worksheets.Add.Range("A2").Resize(res, col - 1).Value = v
      
End Sub
 
Спасибо, Вы меня так выручили. Не перестаю удивляться сколько есть отзывчивых людей, готовых поделиться своими знаниями. Огромная Вам благодарность.
Страницы: 1
Читают тему
Наверх