Страницы: 1
RSS
макрос для сложения строк по условию
 
Уважаемые программисты помогите мне сделать макрос  
во вложении пример таблицы, отталкиваться от сравнения строк, если строки равны , то вторые столбцы (B) этих строк должны сложиться и вынестись куда нибудь..  
 
например так    
 
Итог за лето:  
Иванов 11794  
Петров 10004
 
На некоторых форумах такие ники запрещены :-)
 
Введите в ячейку С2 формулу  
 
=СУММЕСЛИ($A$2:$A$9;A2;$B$2:$B$9)  
 
и протяните её вниз
 
спасибо спасибо за формулу, но таблицы очень большие, мне бы удобнее был макрос
 
Понимаете.... формулу вам легче будет ввести...    
Понимаете, в макросе нужно конкртено указывать в какую ячейку (или ячейки) вставлять данные (формулы). Макрос он менее "гибкий" перед формулой.  
Если хотите, я могу вам написать макрос, который будет вставлять вышеуказанную формулу в столбец С и протягивать её вниз, но мне кажется, это вам не подойдёт
 
Как Китай?
 
)) Китай... отлично)) я, правда, его не люблю ... острая пища, неприятные запахи, грязно на улицах ) В общем, как всегда )) меня скоро там за своего будут принимать )) уже ориентируюсь в Гуанчжоу, как в Москве ))
 
толкните меня на мысль, как после сравнений    
 
 
a = Cells(1, 1)  
For nmb = 3 To 150000  
If a = Cells(b, 1) Then    
 
 
если будут совпадения фамилий, то сложить эти ячейки с зарплатой между собой и итог вынести по этой фамилии , даже если будет 3 и более совпадений фамилий, как мне поймать эти ячйки?
 
Если у вас фамилии идут в столбце А, а зарплата идёт в столбце В, то  
 
Sub Просуммировать()  
Dim iLastRow As Long  
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row  
     
  With Range("C2:C" & iLastRow)  
     .Formula = "=SUMIF($A$2:A$" & iLastRow & ",A2,$B$2:B$" & iLastRow & ")"  
     .Value = .Value  
     .Replace 0, "", xlWhole  
  End With  
End Sub
 
{quote}{login=Pavel55}{date=09.11.2010 11:42}{thema=}{post}Если у вас фамилии идут в столбце А, а зарплата идёт в столбце В, то  
 
Sub Просуммировать()  
Dim iLastRow As Long  
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row  
     
  With Range("C2:C" & iLastRow)  
     .Formula = "=SUMIF($A$2:A$" & iLastRow & ",A2,$B$2:B$" & iLastRow & ")"  
     .Value = .Value  
     .Replace 0, "", xlWhole  
  End With  
End Sub{/post}{/quote}  
совсем хорошо, только бы выводился итог всего одной строчкой, а то напротив одной и той же фамилии один и тот же итог по несколько раз пишется, лучше мне кажется в другой лист кинуть итог
 
Sub Просуммировать()  
Dim iLastRow As Long  
     
  ActiveSheet.Copy After:=Sheets(Worksheets.Count)  
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row  
  On Error Resume Next  
  Range("B2:B" & iLastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
  On Error GoTo 0  
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row  
  With Range("C2:C" & iLastRow)  
     .Formula = "=SUMIF($A$2:A$" & iLastRow & ",A2,$B$2:B$" & iLastRow & ")"  
     .Value = .Value  
  End With  
  Range("A1:A" & iLastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G1"), Unique:=True  
  With Range("H2:H" & Cells(Rows.Count, "G").End(xlUp).Row)  
     .Formula = "=VLOOKUP(G2,A:C,3,0)"  
     .Value = .Value  
  End With  
  Range("H1") = "Сумма"  
  Columns("A:F").Delete  
End Sub
 
А чтобы ещё чуть быстрее было допишите строку  
 
Application.ScreenUpdating = False  
 
в начале моего макроса (после строки Dim iLastRow As Long)
 
А макрос обязательно?
Страницы: 1
Читают тему
Наверх