Добрый день уважаемые жители форума, подскажите пожалуйста есть столбцы a b c d e f g , в столбце А наименование повторяется, необходимо сложить данные , я так понимаю что ЭТО ВПР , но опыта не хватает
Hugo, работает!!! ОГРОМНОЕ СПАСИБО!!!!!!!! файлик я все таки сделал но там добавилось столбик и еще пару условий, я понимаю что бесплатно мало кто захочет делать,сам я не такого уровня как Вы, сколько будет стоить доработать его?
Hugo, работает, если у Вас будет возможность не могли бы вы мне подсказать что дописать что бы в добавок анализировал так же 7,8 столбец но по 9(также как по 3). и результ выводил под результатом 3.
т.е получается
Код
Dim a(), t&, i&, ii&
With CreateObject("Scripting.Dictionary")
a = [A1].CurrentRegion.Value
For i = 2 To UBound(a)
If Not .exists(a(i, 9)) Then
ii = ii + 1: .Item(a(i, 9)) = ii
a(ii, 1) = a(i, 9): a(ii, 2) = a(i, 7)
a(ii, 1) = a(i, 9): a(ii, 3) = a(i, 8)
Else
t = .Item(a(i,9 ))
a(t, 2) = a(t, 2) + a(i, 7)
a(t, 3) = a(t, 3) + a(i, 8)
End If
Next
End With
Dim s As Long
s = Cells(Rows.Count, 12).End(xlUp).Row
Cells(s+1,12).Resize(ii, 3) = a
как объединить с верхним постом #37 ? я с начала попытался сменить переменные но мои попытки не обвенчались успехом(
Hugo, извините за назойливость , вопрос такого характера, а как сделать что бы он это все вставлял после последней заполненной ячейки в столбце допустим 9 ?!
Код
Dim s As Long
s = Cells(Rows.Count, 9).End(xlUp).Row
Cells(s+1,9).Resize(ii, 3) = a
Dim a(), t&, i&, ii&
With CreateObject("Scripting.Dictionary")
a = [A1].CurrentRegion.Value
For i = 2 To UBound(a)
If Not .exists(a(i, 3)) Then
ii = ii + 1: .Item(a(i, 3)) = ii
a(ii, 1) = a(i, 3): a(ii, 2) = a(i, 7)
a(ii, 1) = a(i, 3): a(ii, 3) = a(i, 8)
Else
t = .Item(a(i, 3))
a(t, 2) = a(t, 2) + a(i, 7)
a(t, 3) = a(t, 3) + a(i, 8)
End If
Next
End With
[l2].Resize(ii, 3) = a
с третьей попытки ))) Hugo,спасибо Вам большое за урок
подскажите пожалуйста , а как сделать что бы складывал не только 7 столбец но и 8 тоже (((
Код
Sub tt()
Dim a(), t&, i&, ii&
With CreateObject("Scripting.Dictionary")
a = [a1].CurrentRegion.Value
For i = 2 To UBound(a) '1-ю строку игнорируем
If Not .exists(a(i, 3)) Then
ii = ii + 1: .Item(a(i, 3)) = ii
a(ii, 1) = a(i, 3): a(ii, 2) = a(i, 7)
Else
t = .Item(a(i, 3))
a(t, 2) = a(t, 2) + a(i, 7)
End If
Next
End With
Workbooks.Add(1).Sheets(1).[a1].Resize(ii, 2) = a
End Sub
Добрый день друзья , прошу помощи, в очередной раз - надеюсь на ВАС) подскажите пожалуйста
есть лист на нем 13 столбцов : как с помощью vba обвести все строки(13 столбцов) со 2 по последнюю (заполненную) определяющий признак заполненная строка или нет - первый столбец.