Добрый день, можно с доп столбцами попробовать

Добрый день, добавьте в формулу массива еще одно условие (перед условием на время) "{=МАКС(ЕСЛИ(A:A=H2;ЕСЛИ((B:B<J3)*(B:B>=I3);D:D)))}"

Я обычно так нахожу последнюю строчку "konec = Cells(Rows.Count, 4).End(xlUp).Row" потом переменную "konec" использую в "Range("D" & konec+1)"

Через еслиошибка() можно НД заменить на 0

Добрый день, так сойдет?! )

А почему бы тогда Вам не тратить время на Access и сделать все эти деления и обновления в самом Excel?
no problem

У Вас база Access типа "Клиент"-"Сервер", или же Вы Access используете просто для операции БД?

В VBA, лучше всего дайте файлы с примерами )

Может выложите примерчик с Excel и Access файлом, или сходите на http://www.cyberforum.ru/ms-access/ там помогут с Access.

Примерно так

DAO.Recordset не спасет? Если в него записать SQL запрос условием отбора, после обнулить и закрыть.

Добрый день, формула "СЧЁТЕСЛИ(N:N;"Российская Федерация")" посчитала 118 штук.

добавил доп столбец.

Можно еще так

срез сойдет?

Johny, не получилось у меня без смайликов, все равно показывает смайлики

Hugo, да именно так, )))))
Jack, у меня есть код, нооо его будет трудно прочитать )))), и он не всегда верно распределяет, видать какой то из циклов сбивается или что

Скрытый текст

Sub deleshka1()    Dim arnetfk, arshtat, arkol, arsym, ij, arfio    Dim lLastRow As Long    Dim lLastCol, ilast As Long    Dim sym As Long    Sheets("Штат"    .Select    Set arshtat = Range(Cells(2,    , Cells(Rows.Count,    .End(xlUp))    Set arfio = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))    Sheets("Таблица(линк)"    .Select    Set arkol = Range(Cells(9, 3), Cells(28, 3))    Set arsym = Range(Cells(9, 6), Cells(28, 6))    Sheets("нетФК"    .Select    j = 1    For i = 1 To 1        lLastRow = Cells(Rows.Count, 1).End(xlUp).Row        h = arshtat(i)        Do While h >= 1                ilast1 = Range("R1"    + 2                ilast = Range("R1"    + 2                Set arnetfk = Range(Cells(ilast1, 7), Cells(Rows.Count, 7).End(xlUp))                lLastCol = Cells(Rows.Count, 1).End(xlUp).Row - ilast1 + 1                sym = 0                sym = arnetfk(j) + sym                If Round(((arsym(i) + 10000) / 1000), 0) <= Round((sym / 1000), 0) Then                    Cells(ilast, 32) = arfio(h)                    ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort.SortFields.Clear                    ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort.SortFields.Add Key:=Range( _                    "Af1:Af" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _                    xlSortNormal                    With ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort                        .Header = xlYes                        .MatchCase = False                        .Orientation = xlTopToBottom                        .SortMethod = xlPinYin                        .Apply                    End With                    ilast = ilast + 1                    GoTo 1                End If                sym = 0                For j = 1 To lLastCol                    sym = arnetfk(j) + sym                    If (Round((arsym(i) / 1000), 0) - Round((sym / 1000), 0)) < 0 Then                        sym = sym - arnetfk(j)                        ilast = ilast + 1                        Else                            Cells(ilast, 32) = arfio(h)                            ilast = ilast + 1                            If Round((arsym(i) / 1000), 0) - Round((sym / 1000), 0) <= 1 Or j = lLastCol - 1 Then                                GoTo 1                            End If                    End If                Next j 1:                h = h - 1                ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort.SortFields.Clear                ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort.SortFields.Add Key:=Range( _                "Af1:Af" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _                xlSortNormal                With ActiveWorkbook.Worksheets("нетФК"    .AutoFilter.Sort                    .Header = xlYes                    .MatchCase = False                    .Orientation = xlTopToBottom                    .SortMethod = xlPinYin                    .Apply                End With                j = 1        Loop        If Cells(ilast, 32) = "" Then            Cells(ilast, 32) = Cells(ilast - 1, 32)        End If    Next i End Sub

как убрать смайлики в тексте?!

Jack,Hugo,          , щас напишу подробно, надеюсь кроме меня остальные тоже поймут )

вот смотрите, у меня в примере есть столбец "Сумма для распределения", так вот те суммы которые есть там, нужно распилить поровну на всех сотрудников которые есть в филиале (в примере указал только 2 филиала), эти сотрудники указаны в листе "Штат".
Пример: возьмем 1 филиал, в 1 филиале есть 13 сотрудников, на которых нужно раскидать те суммы которые указаны в листе "База" столбец "Сумма для распределения" так чтобы она не превысила допустимую сумму на 1 сотрудника в 1 филиале (эта сумма равна 2 885 661)
Если снова кроме меня никто не поймет, можно тему закрыть, чтоб никто больше не утрировал )))), не получается у меня сегодня излогать свои мысли
Заранее благодарю

hk1209, в примере все вроде написано, и столбец есть ПРИМЕР - это так как должно получится.

Добрый день, на работе придумали новую мативационную тему, ну как обычно это бывает руководству главное придмуать а как ее реализовать не их проблема ) но надо ее сделать. Я сделал ее, но он по моему не очень корректно все считает. То что нужно сделать написано в файле, если будут вопросы могу еще подробнее расписать что нужно сделать.
Заранее благодарю.

JayBhagavan, )))))) тогда из за Вас мой ответ вообще не вариант как решение )))) эээх  Вы

Daos, прикольно у Вас ))) планировать в убыток ), обычно как планируют на столько сколько продали первые месяца три чтоб выполнение было на 100% после нового года, а остальное раскидывают потом на оставшиеся месяцы. Ну эт наверное смотря где и как ) у меня в компашке планируют на столько сколько выдали а потом

nebot,

так можно найти активную ячейку, ну эт мой метод ))) может есть еще короче и лучше )), я б не отказался узнать если есть

уже, хочу его добить, чтоб пользователь мог его с надсроек запускал в любой книге и для любого столбца, которые содержит даты в кривом формате

Hugo, спасибо огромное за помощь, и за время которое уделили )

вот вот, ерунда ваще, дело по сути плевое, вариантов как бы куча, даже для таких как я (не много знающих про VBA) записать через макроредактор CTRL+H, но он не помог (, когда просто меняешь через CTRl+H все норма, запускаешь макрос фигня полная )

Добрый день

ясно, спс, матаю на ус ), а как бы она мне помогла решить проблему которая у меня была?!

Johny, спс попробую как Вы написали
Hugo, спс за вариант, но у меня ничего не получилось, не совсем понял что делает "Columns(ActiveCell.Column).TextToColumns"
А как можно сделать проверку на содержание ячейку?! Есть ли там даты или там текст или там цифры "If (IsDate(ActiveCell)) And ActiveCell.Value Like "*.*.*" Then" этот вариант подходит для проверки?!

Abakumov, благодарю Вас за решение моей проблемки )