Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как повторяющиеся значения суммировать и изменить type
 
Всем день добрый.
Как повторяющиеся значения суммировать и записать в одно поле + изменить (type).
Ранее, пытался изменить формат на date, но без результативно:
Код
Dim i As Date, LastRow As Date, FreeRowStroy As Date, iCol As Date
Dim ii As Date, CounterStroy As Long, CounterMont As Long, DR As String
Dim FreeRowMont As Date, FreeRow1 As Date, Rng As Range, n As Date, RowStart As Date

Кто может, помогите в решении проблемы. Спасибо большое.

 
vsolovev, Ваш файл не смотрел: слишком большой для решения проблемы. Но помню старое сообщение с аналогичным вопросом: как часы превратить в дни. Посмотрите вариант в МАЛЕНЬКОМ файле. Обратите внимание на формат итоговых ячеек.
 
Цитата
Юрий М написал:
слишком большой для решения проблемы
Может будет время? Буду безумно признателен!  
 
Разобрался, я с форматом ячеек. А вот, повторяющиеся значения суммировать и записать в одно поле....никак. Может кто даст наводку?
 
для суммирования используйте знак +
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
для суммирования используйте знак +
Я начинающий - ламер в этом вопросе))), можно кодом показать...если Вам не тяжело?
Изменено: vsolovev - 17 Сен 2018 14:24:22
 
vsolovev, Так что нужно-то? То, что в файле (как бы часы при  работе макроса перевести значение в дробное число (Дни)) или то, что в первом посте?
 
StoTisteg, с дробными числами и днями разобрался. Нужно суммировать несколько значений одинаковых в одну ячейку. в файле на листе 3 визуально отобразил, как хотелось бы видеть  
 
Если то, что в файле, то для ячейки C3, например,
Код
Dim ds As Double
ds = CDbl(CDate(Cells(3, 3).Value))
 
Цитата
StoTisteg написал:
Нужно суммировать несколько значений одинаковых
Эта операция называется "умножение" :)
Изменено: StoTisteg - 17 Сен 2018 14:32:59
 


х
Изменено: vsolovev - 17 Сен 2018 14:49:54
 
Цитата
StoTisteg написал:
Эта операция называется "умножение"
Можете на моем коде показать, не хватает знаний правильно прописать Ваш код.
Код
Sub Macro2()
Dim i As Long, LastRow As Long, FreeRowStroy As Double, iCol As Long
Dim ii As Date, CounterStroy As Long, CounterMont As Long, DR As String
Dim FreeRowMont As Long, FreeRow1 As Long, Rng As Range, n As Long, RowStart As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range(Cells(2, 1), Cells(LastRow + 1, 7)).Clear
    FreeRowStroy = 2
    FreeRowMont = 2
    FreeRow1 = 2
    RowStart = 2
    n = 3
  
    With Sheets("Кгот.")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = n To LastRow
            If .Cells(i, 1) <> "" Then
                DR = .Cells(i, 1)
                Cells(FreeRow1, 1) = .Cells(i, 1)
            End If                                            'выводит подразделение
            For ii = i To LastRow
                If .Cells(ii, 1) = DR Or .Cells(ii, 1) = "" Then
                    If .Cells(ii, 3) > 0 Then
                        Set Rng = Sheets("справочник").Range("B2:C999").Find(what:=.Cells(ii, 2), LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Rng Is Nothing Then
                            If Rng.Column = 2 Then
                                Cells(FreeRowStroy, 2) = .Cells(ii, 2)
                                Cells(FreeRowStroy, 4) = .Cells(ii, 3)
                                CounterStroy = CounterStroy + 1
                                FreeRowStroy = FreeRowStroy + 1
                            Else
                                Cells(FreeRowMont, 5) = .Cells(ii, 2)
                                Cells(FreeRowMont, 7) = .Cells(ii, 3)
                                
'''''''                                Dim ds As Double
'''''''                                ds = CDbl(CDate(Cells(3, 3).Value))
                                
                                CounterMont = CounterMont + 1
                                FreeRowMont = FreeRowMont + 1
                            End If
                        End If
                    End If
                Else
                    i = ii - 1
                    If FreeRowStroy > FreeRowMont Then
                        FreeRow1 = FreeRowStroy
                    Else
                        FreeRow1 = FreeRowMont
                    End If
                    Cells(FreeRow1, 2) = "Итого:" & DR
                    Cells(FreeRow1, 3) = CounterStroy
                    Cells(FreeRow1, 5) = "Итого:" & DR
                    Cells(FreeRow1, 6) = CounterMont
'                    Cells(FreeRow1, 4) = Application.Text(ttime, "[hh]:mm")
'                    Cells(FreeRow1, 7) = Application.Text(ttime, "[hh]:mm")
                    CounterStroy = 0
                    CounterMont = 0
                    With Range(Cells(RowStart, 1), Cells(FreeRow1, 1))
                        .Merge
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .BorderAround Weight:=xlThin
                    End With
                    Range(Cells(FreeRow1, 2), Cells(FreeRow1, 7)).Interior.ColorIndex = 15
                    Range(Cells(RowStart, 2), Cells(FreeRow1, 7)).Borders.LineStyle = True
                    Cells(FreeRow1, 4) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 4), Cells(FreeRow1, 4))) / 24 '-< Добавлено
                    Cells(FreeRow1, 7) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 7), Cells(FreeRow1, 7))) / 24 '-< Добавлено
                    RowStart = FreeRow1 + 1
                    FreeRow1 = FreeRow1 + 1
                    FreeRowStroy = FreeRow1
                    FreeRowMont = FreeRow1
                    Exit For
                End If
            Next
            If ii > LastRow Then
                Cells(FreeRow1 + 25, 2) = "Итого:" & DR
                Cells(FreeRow1 + 25, 3) = CounterStroy
                Cells(FreeRow1 + 25, 5) = "Итого:" & DR
                Cells(FreeRow1 + 25, 6) = CounterMont
'                Cells(FreeRow1 + 25, 4) = Application.Text(ttime, "[hh]:mm")
'               Cells(FreeRow1 + 25, 7) = Application.Text(ttime, "[hh]:mm")
                With Range(Cells(RowStart, 1), Cells(FreeRow1 + 25, 1))  ' изменения дороги
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .BorderAround Weight:=xlThin
                End With
                Range(Cells(FreeRow1 + 25, 2), Cells(FreeRow1 + 25, 7)).Interior.ColorIndex = 17
                Range(Cells(RowStart, 2), Cells(FreeRow1 + 25, 7)).Borders.LineStyle = True
                Cells(FreeRow1 + 25, 4) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 4), Cells(FreeRow1 + 5, 4))) ' / 24  '-< Добавлено
                Cells(FreeRow1 + 25, 7) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 7), Cells(FreeRow1 + 5, 7))) '/ 24 '-< Добавлено
                Exit Sub
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Страницы: 1
Читают тему (гостей: 1)
Наверх