Здравствуйте ! В базу данных ввожу информацию по объектам, в части ячеек до 30-ти позиций, в соседнюю ячейку вручную ввожу общую стоимость. Возможно ли общую стоимость заполнять формулой ? Формулы массива и макросы не предлагайте, "Офис" пенсионного возраста, часто виснет даже оп пустякам!
Здравствуйте ! В базу данных ввожу информацию по объектам, в части ячеек до 30-ти позиций, в соседнюю ячейку вручную ввожу общую стоимость. Возможно ли общую стоимость заполнять формулой ? Формулы массива и макросы не предлагайте, "Офис" пенсионного возраста, часто виснет даже оп пустякам!Ннотик
По идее макрос не будет работать с БД, а будет работать только с активным листом (это лист, который отображается на мониторе). Поэтому прямой связи с БД не видно (может быть она и есть, но мне не видно).
По идее макрос не будет работать с БД, а будет работать только с активным листом (это лист, который отображается на мониторе). Поэтому прямой связи с БД не видно (может быть она и есть, но мне не видно).Karataev
Ннотик, А мне другое любопытно - что у Вас за такая интересная "база", в которой в одной ячейке такая туча информации внесена? Это специально так, чтобы того, кто с этой базой работает, никогда не уволили?
Ннотик, А мне другое любопытно - что у Вас за такая интересная "база", в которой в одной ячейке такая туча информации внесена? Это специально так, чтобы того, кто с этой базой работает, никогда не уволили?_Boroda_
_Boroda_, ... это всегда бывает, когда работодатель не тратится на готовое ПО... в принципе ни на что не тратится... ...и таки ДА ! следующим моим наказанием будет выделение каждого объекта построчно ! (но я до этого еще не додумалась! не знаю что с остальными данными делать!) ...
_Boroda_, ... это всегда бывает, когда работодатель не тратится на готовое ПО... в принципе ни на что не тратится... ...и таки ДА ! следующим моим наказанием будет выделение каждого объекта построчно ! (но я до этого еще не додумалась! не знаю что с остальными данными делать!) ... Ннотик
_Boroda_, про наоборот 5 лет назад никто не подумал, а теперь я пытаюсь облегчить себе работу... выполняя прихоти руководства... и... мечтая чтоб уволили... тока пойти та некуда!
_Boroda_, про наоборот 5 лет назад никто не подумал, а теперь я пытаюсь облегчить себе работу... выполняя прихоти руководства... и... мечтая чтоб уволили... тока пойти та некуда!Ннотик
Вариант макросом. Для макроса Вам надо будет сделать кнопку. Щелкаете кнопку, запускается макрос, который пройдет по всем строкам с 4 до последней и вставит результат в столбец "D". Если макросами никогда не пользовались, то посмотрите в интернете или создайте новую тему (но сначала воспользуйтесь поиском на форуме).
Предполагается, что данные начинаются со строки 4 (как в файле примере). Если на конце строки структура данных отличается от той, что в примере, то строка закрасится красным и макрос в конце об этом сообщит.
[vba]
Код
Sub Суммировать()
Dim arrSrc(), arrRes(), var, var2, dblSum As Double Dim boolErr As Boolean, lr As Long, i As Long, ii As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row If lr = 4 Then ReDim arrSrc(1 To 1, 1 To 1) arrSrc(1, 1) = Range("C4").Value Else arrSrc() = Range("C4:C" & lr).Value End If ReDim arrRes(1 To UBound(arrSrc), 1 To 1)
For i = 1 To UBound(arrSrc) dblSum = 0 var = Split(arrSrc(i, 1), Chr(10)) For ii = 0 To UBound(var) var2 = Mid(var(ii), InStrRev(var(ii), "_") + 1) var2 = Left(var2, InStrRev(var2, " ") - 1) If IsNumeric(var2) = False Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For Else dblSum = dblSum + CDbl(var2) End If Next ii arrRes(i, 1) = dblSum Next i
If boolErr = True Then MsgBox "Некоторые строки имеют неизвестную структуру!", vbCritical Else MsgBox "Готово!", vbInformation End If
End Sub
[/vba]
Вариант макросом. Для макроса Вам надо будет сделать кнопку. Щелкаете кнопку, запускается макрос, который пройдет по всем строкам с 4 до последней и вставит результат в столбец "D". Если макросами никогда не пользовались, то посмотрите в интернете или создайте новую тему (но сначала воспользуйтесь поиском на форуме).
Предполагается, что данные начинаются со строки 4 (как в файле примере). Если на конце строки структура данных отличается от той, что в примере, то строка закрасится красным и макрос в конце об этом сообщит.
[vba]
Код
Sub Суммировать()
Dim arrSrc(), arrRes(), var, var2, dblSum As Double Dim boolErr As Boolean, lr As Long, i As Long, ii As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row If lr = 4 Then ReDim arrSrc(1 To 1, 1 To 1) arrSrc(1, 1) = Range("C4").Value Else arrSrc() = Range("C4:C" & lr).Value End If ReDim arrRes(1 To UBound(arrSrc), 1 To 1)
For i = 1 To UBound(arrSrc) dblSum = 0 var = Split(arrSrc(i, 1), Chr(10)) For ii = 0 To UBound(var) var2 = Mid(var(ii), InStrRev(var(ii), "_") + 1) var2 = Left(var2, InStrRev(var2, " ") - 1) If IsNumeric(var2) = False Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For Else dblSum = dblSum + CDbl(var2) End If Next ii arrRes(i, 1) = dblSum Next i
Внес изменения в макрос, чтобы учитывалась ситуация, когда в строке нет знака подчеркивания и пробела.
[vba]
Код
Sub Суммировать()
Dim arrSrc(), arrRes(), var, var2, dblSum As Double Dim boolErr As Boolean, lr As Long, i As Long, ii As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row If lr = 4 Then ReDim arrSrc(1 To 1, 1 To 1) arrSrc(1, 1) = Range("C4").Value Else arrSrc() = Range("C4:C" & lr).Value End If ReDim arrRes(1 To UBound(arrSrc), 1 To 1)
For i = 1 To UBound(arrSrc) dblSum = 0 var = Split(arrSrc(i, 1), Chr(10)) For ii = 0 To UBound(var) If Not var(ii) Like "*_* *" Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For End If var2 = Mid(var(ii), InStrRev(var(ii), "_") + 1) var2 = Left(var2, InStrRev(var2, " ") - 1) If IsNumeric(var2) = False Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For Else dblSum = dblSum + CDbl(var2) End If Next ii arrRes(i, 1) = dblSum Next i
If boolErr = True Then MsgBox "Некоторые строки имеют неизвестную структуру!", vbCritical Else MsgBox "Готово!", vbInformation End If
End Sub
[/vba]
Внес изменения в макрос, чтобы учитывалась ситуация, когда в строке нет знака подчеркивания и пробела.
[vba]
Код
Sub Суммировать()
Dim arrSrc(), arrRes(), var, var2, dblSum As Double Dim boolErr As Boolean, lr As Long, i As Long, ii As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row If lr = 4 Then ReDim arrSrc(1 To 1, 1 To 1) arrSrc(1, 1) = Range("C4").Value Else arrSrc() = Range("C4:C" & lr).Value End If ReDim arrRes(1 To UBound(arrSrc), 1 To 1)
For i = 1 To UBound(arrSrc) dblSum = 0 var = Split(arrSrc(i, 1), Chr(10)) For ii = 0 To UBound(var) If Not var(ii) Like "*_* *" Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For End If var2 = Mid(var(ii), InStrRev(var(ii), "_") + 1) var2 = Left(var2, InStrRev(var2, " ") - 1) If IsNumeric(var2) = False Then Rows(4).Resize(UBound(arrSrc)).Rows(i).Interior.Color = 9737946 boolErr = True Exit For Else dblSum = dblSum + CDbl(var2) End If Next ii arrRes(i, 1) = dblSum Next i
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
