Уважаемые профи форума. Подскажите как можно доработать мое творение. Ситуация такая. На листе имеется форма FindPasteForm, предназначенная для поиска/вставки информации. Источником данных для листбокса этой формы является указанный диапазон на скрытом листе. Данные на этот скрытый лист попадают при активации листа Приход, в результате работы простейшего макроса:
Код
Private Sub Worksheet_Activate()
Dim LastRow_p As Long
LastRow_p = Sheets("Приход").Cells(Rows.Count, [Tovar_prihoda].Column).End(xlUp).Row
Sheets("Приход").Range(Cells(2, 8, Cells(LastRow_p, 8).Copy Sheets("Список").Range("A1")
With Sheets("Список")
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=1
.Sort.SetRange Range("A1").CurrentRegion 'определение диапазона
.Sort.Apply 'сортировка
End With
End Sub
И еще на FindPasteForm имеется возможность по вводу в текстбокс первых букв слова, производить фильтрацию данных в листбоксе. Я попытался избавиться от скрытого листа и, соответственно, макроса копирования информации, использовав для этого словарь:
Код
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim LastRow_p As Long, i As Long, iMassiv As Variant
LastRow_p = Sheets("Приход").Cells(Rows.Count, [Tovar_prihoda].Column).End(xlUp).Row
iMassiv = Range(Sheets("Приход").Cells(2, 8, Sheets("Приход").Cells(LastRow_p, 8)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(iMassiv)
.Item(iMassiv(i, 1)) = 1
Next
Me.ListBox1.List = .Keys
End With
Application.ScreenUpdating = False
End Sub
Данные в Listbox1 оказываются правильные, НО далее начинаются вопросы. Во-первых, как организовать сортировку этих данных по алфавиту? И во-вторых, как организовать фильтрацию данных по вводу букв в текстбокс? (по аналогии с работающим кодом формы FindPasteForm). Второе более важно (очень сильно пользователю облегчает ввод данных возможность такой фильтрации). Заранее спасибо всем откликнувшимся.
Данные из словаря в Listbox, Поместить данные, рассчитанные с помощью словаря, в Listbox
Пользователь
Сообщений: Регистрация: 18.01.2013
16.01.2016 21:17:37
Уважаемые профи форума. С Вашей помощью я смог немного освоить использование словаря, НО вылез следующий вопрос. Сейчас для формирования данных для listbox, находящегося на UserForm6, используется столбец 15 на листе "Приход". Данные в этот столбец попадают в результате работы макроса (также предложенного на этом уважаемом мною форуме ). Я попытался исключить этап работы этого макроса и сэкономить время . На листе "Тест" по нажатию кнопки срабатывает макрос:
Код
Application.ScreenUpdating = False
Dim i As Long, j As Long, a As Variant, k As Variant, x As Variant
With CreateObject("Scripting.Dictionary")
.CompareMode = 1 'если в массиве только числа, то можно без этой строки
x = Sheets("Приход").Range("B2:N" & Sheets("Приход").Cells(Rows.Count, 8.End(xlUp).Row).Value 'данные в массив
For i = 1 To UBound(x)
If Month(CDate(x(i, 4))) & Year(CDate(x(i, 4))) = Month([A1] & "." & Year([B1])) & Year([B1]) Then
.Item(x(i, 1) & "|" & x(i, 3) & "|" & x(i, 6) & "|" & x(i, 5)) = .Item(x(i, 1) & "|" & x(i, 3) & "|" & x(i, 6) & "|" & x(i, 5)) + x(i, 13)
End If
Next i
ReDim a(1 To .Count, 1 To 5)
For Each k In .keys
j = j + 1
a(j, 1) = Format(Split(k, "|")(0), "П-0000")
a(j, 2) = Format(Split(k, "|")(1), "dd.mm.yyyy")
a(j, 3) = Split(k, "|")(2)
a(j, 4) = Split(k, "|")(3)
a(j, 5) = Format(Split(.Item(k), "-")(0), "0.00")
Next k
[A11].Resize(UBound(a, 1), UBound(a, 2)).Value = a 'выгрузка результата
End With
Application.ScreenUpdating = True
который с помощью словаря правильно и быстро отбирает данные. Как эти полученные данные выгрузить на лист, мне было показано, когда я поднимал тему формирования массивов, и это у меня получается. А вот как поместить эти данные в Listbox я пока не знаю. Будьте добры, покажите как это сделать на примере моей формы (учитывая, что параметр Month([A1] & "." & Year([B1])) & Year([B1]) Then для формы будет выглядеть как Month(Me.Mes.Value & "." & Year(Date)) & Me.God Then. Заранее спасибо всем откликнувшимся.
Делим "слипшийся" текст в массиве на части, модернизировать функцию пользователя
Пользователь
Сообщений: Регистрация: 18.01.2013
13.01.2016 07:52:39
Уважаемые профи форума. В Примерах приведена функция пользователя:
Код
Function Substring(Txt, Delimiter, n) As String
Dim x As Variant
x = Split(Txt, Delimiter)
If n > 0 And n - 1 <= UBound(x) Then
Substring = x(n - 1)
Else
Substring = ""
End If
End Function
Все работает замечательно, НО функция делит текст только в конкретно указанной ячейке. А можно ли изменить эту функцию, чтобы аналогичные действия она могла выполнять для указанного диапазона? Поясню, в прилагаемом примере диапазону А3:А5 присвоено имя Test. При попытке использовать это имя в качестве адреса для приведенной функции ответом становится #ЗНАЧ. Сейчас для одной из задач я использую несколько видов разделителей и, соответствнно, несколько функций (ЛЕВСИМВ, ПСТР, ПРАВСИМВ) для их разделения и использования полученных значений. При возможности модернизации вышеприведенной функции пользователя, размер моей формулы существенно сократится. Если же моденизация невозможна, ничего страшного, все останется как есть. Заранее спасибо всем откликнувшимся. P.S. я так понимаю что формула, в случае модернизации, станет формулой массива, меня это полностью устраивает.
Склейка результатов работы фильтра
Пользователь
Сообщений: Регистрация: 18.01.2013
09.01.2016 13:03:57
Уважаемые профи форума. Недавно, по ходу обсуждения моего вопроса касательно создания массивов Kuzmich предложил простое решение по извлечению уникальных данных. В прилагаемом примере код:
Код
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim LastRow_p As Long, LastRow_rez As Long
LastRow_p = Cells(Rows.Count, 4).End(xlUp).Row
Range("C1:D" & LastRow_p).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("O1"), Unique:=True
Application.ScreenUpdating = True
End Sub
правильно извлекает уникальные данные и помещает их, начиная с указанной ячейки О1. Но дело в том, что данные мне нужны немного не в таком виде, а именно в соединенном значении этих столбцов. Т.е. вместо 28.03.2013 в ячейке О2 и Шестакова Наталья Викторовна в ячейке Р2 мне необходимо увидеть значение 41361Шестакова Наталья Викторовна в какой-либо указанной ячейке. Причем хотелось бы, чтобы операция по "склеиванию" данных происходила прямо по ходу выполнения кода (вариант с формулой в ячейке, склеивающей значения, полученные текущим кодом, я бы и сам смог сделать, но он не нравится). Можно ли это сделать и, если можно, то как? Заранее спасибо всем откликнувшимся.
Формирование массива с помощью словаря
Пользователь
Сообщений: Регистрация: 18.01.2013
05.01.2016 18:59:41
Уважаемые профи форума. Совсем недавно я обращался на форум за помощью в формировании массива данных с последующей выгрузкой оного массива на лист и мне была оказана реальная помощь, причем в нескольких вариантах. Да не обидятся на меня Юрий М, и Мотя, предложившие свои варианты, но я выбрал вариант от (самое главное он был лишен небольшого недочета, проявляющегося при одиночном номере договора). Но на листе отчета мне требовались сформировать еще два массива данных с похожими требованиями, только для расхода и возврата товара. Для расхода товара, воспользовавшись кодом от , я смог написать код сам, Для возврата товара - почти смог. В прилагаемом примере формирование и выгрузка массивов повешены на 3 соответствующие кнопки. Приход и расход отрабатывают полностью правильно, а с формированием массива для возврата товар возник вопрос. Сейчас мой код правильно отбирает фамилии комитентов, даты возврата и суммы по этим возвратам, но НЕ СОВСЕМ правильно выбирает номера договоров по этим возвратам. Код для этого используется следующий:
Код
Application.ScreenUpdating = False
Dim i As Long, j As Long, a As Variant, b As Variant, x As Variant, k As Variant
Range("A215:D227").ClearContents 'очистка диапазона
from = CDate([E11])
untill = CDate([F11])
x = Sheets("Расход").Range("A2:I" & Sheets("Расход").Cells(Rows.Count, 3).End(xlUp).Row).Value 'данные в массив
With CreateObject("Scripting.Dictionary")
.CompareMode = 1 'если в массиве только числа, то можно без этой строки
For i = 1 To UBound(x)
If CDate(x(i, 1)) >= from And CDate(x(i, 1)) <= untill And x(i, 7) = "В" Then 'проверка на дату в нужном диапазоне
.Item(x(i, 9) & "|" & x(i, 1)) = .Item(x(i, 9) & "|" & x(i, 1)) + (x(i, 4) * x(i, 5))
End If
Next i
For i = 1 To UBound(x)
If CDate(x(i, 1)) >= from And CDate(x(i, 1)) <= untill And x(i, 7) = "В" Then 'проверка на дату в нужном диапазоне
.Item(x(i, 9) & "|" & x(i, 1)) = .Item(x(i, 9) & "|" & x(i, 1)) & "-" & Mid(x(i, 2), InStrRev(x(i, 2), "|") + 1)
End If
Next i
ReDim a(1 To .Count, 1 To 4)
For Each k In .keys
j = j + 1
a(j, 1) = "Возврат " & Split(k, "|")(0)
a(j, 2) = Split(k, "|")(1)
b = Split(.Item(k), "-")
a(j, 3) = Split(.Item(k), "-")(1) & IIf(UBound(b) <> 1, ", " & Split(.Item(k), "-")(UBound(b)), "")
a(j, 4) = Split(.Item(k), "-")(0)
Next k
Sheets("Товарный отчет").Range("A215").Resize(UBound(a, 1), UBound(a, 2)).Value = a 'выгрузка результата
End With
Application.ScreenUpdating = True
В прилагаемом примере на листе Расход 20.11.2015 имеются 3 возврата товара поставщику Вагнер Л.А. с договорами 451., 395., 711. А в массив попадают только номера 451. и 711., при этом сумма за это число считается правильно. Я понимаю, что это обусловлено кодом, но вот как этот код изменить, чтобы в данном случае он просто перечислял через запятую все подходящие договора я решить никак не смог. Подскажите, пожалуйста, как это сделать? И еще, уважаемые профи, подскажите, а лучше покажите , как, если это можно сделать, объединить все три части в одну, чтобы код последовательно сформировал и выгрузил в соответствующие ячейки необходимые данные. Заранее спасибо всем откликнувшимся.
Замена формул на код VBA
Пользователь
Сообщений: Регистрация: 18.01.2013
03.01.2016 10:16:45
Уважаемые профи форума, подскажите, пожалуйста, можно ли решить данный вопрос. Мне очень помогли на форуме, показав как можно сначала формировать массив данных, а затем выгружать его на лист. Увидев, что замена формул массива (применявшихся до сих пор) на такой вариант ускоряет работу, я попытался заменить формулы массива и на других страницах документа, но столкнулся с проблемой: В моем коде VBA из 4 необходимых позиций у меня получилось отобрать 2, а вот с 3 и 4 позициями возникла проблема. На листе Товарный отчет в ячейках K21:K30 приводится пример прежнего решения отбора данных с помощью формулы массива:
Фактически, формула ищет минимальный и максимальный номера договора в ограниченном условиями диапазоне и "склеивает" их. В своем коде я попытался сделать это так:
Код
For j = 2 To LastRow_p
If Sheets("Приход").Cells(j, [komit].Column) = arr_p(1, iarr_p) And CDate(Sheets("Приход").Cells(j, [Data_dokumenta_prihoda].Column)) = arr_p(2, iarr_p) Then
arr_p(3, iarr_p) = Application.Min(Left(Sheets("Приход").Cells(j, 2), InStr(Sheets("Приход").Cells(j, 2), ".") - 1))
End If
Next
Частично получилось, но во-первых код в текущем варианте ищет значение не в диапазоне, а ячейке (поэтому аналогичное значение будет и для Max(...)), а вот как указать массив из номеров договоров, подходящих по условиям, я не знаю и во-вторых точка в номере договора может присутствовать, а может и нет, а текущий код в такой ситуации (и с точками и без) выпадает с ошибкой. Так вот вопрос можно заменить формулу из ячеек K21:K30 на код VBA при формировании нужного мне массива? И еще, как прописать в коде нахождение суммы по поставке. Сейчас используется СУММПРОИЗВ (ячейки L21:L30), но мои попытки заменить ее на SumProduct даже в самом простом варианте без отбора пока окончились неудачей. Заранее спасибо всем откликнувшимся.
Поиск данных в части строки
Пользователь
Сообщений: Регистрация: 18.01.2013
29.12.2015 14:32:11
Уважаемые профи форума, подскажите пожалуйста, как решить возникший вопрос. Ситуация такая. На листе «Выплаты комитентам» через форму вносятся данные. По деактивации страницы выполняется следующий код:
Код
Private Sub Worksheet_Deactivate()
Dim MyArr As Variant, i As Integer
MyArr = [Dogovor_VK]
[Nomer_dogovora].Font.ColorIndex = xlAutomatic
For i = 1 To UBound(MyArr)
Set r = [Nomer_dogovora].Find(what:=MyArr(i, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then r.Font.Color = 255
Next
End Sub
Далее на листе «Расход» с помощью функции пользователя:
Код
Function ColorFont(Cells As Range) As Integer
Colfon = Cells.Font.ColorIndex
If Colfon = -4105 Then Colfon = 0
ColorFont = Colfon
End Function
в нужные ячейки вставляется тот или иной результат, который используется в дальнейших расчетах. Все работает как описано, но дело в том, что функция пользователя работает только при пересчете листа и периодически возникают ситуации, когда при формировании других форм данных в столбце признака закрытия договора не оказывается и, соответственно форма не формируется так, как было задумано, да и использование ДВССЫЛ, судя по многочисленным мнениям форумчан не особо правильно, т.к. вынуждает пересчитывать все данные. Теперь наконец-то вопрос. Как по аналогии с закрашиванием ячейки, выполнить поиск этих же данных (т.е. номера договора) в столбце «В» листа «Расход» и, при нахождении, вставить в ячейку находящуюся левее, слово «закрыт». Проблема в том, что номер договора в этом столбце нужно предварительно вычленить из конструкции типа Мухомор с лягушкой|442. Мои попытки сделать это конструкциями:
успеха не принесли. Можно ли осуществить задуманное или так искать данные Excel не сможет? Меня собственно устроит и любой другой вариант решения задачи, самое главное, чтобы значение «закрыт» или «открыт» попадали на свои места листа Расход через VBA, без использования формул. Заранее спасибо всем откликнувшимся.
Скрытие вычисленных строк
Пользователь
Сообщений: Регистрация: 18.01.2013
28.12.2015 12:23:14
Уважаемые профми форума, подскажите, пожалуйста, как решить небольшой вопрос. Небходимо скрыть строки, начиная от вычисленной до указанной. Переменная LRow в коде вычисляется правильно, а вот как дальше склеить полученное значение, никак не соображу. Макрорекодером-то просто выглядит:
Код
Rows("6:10").EntireRow.Hidden = True
А вот где в моей конструкции ошибка закралась, укажите.
Код
Private Sub CommandButton1_Click()
Dim LRow As Long
LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(" & LRow + 1 &:10").EntireRow.Hidden = True
End Sub
Заранее спасибо всем откликнувшимся.
Изменено: - 28.12.2015 12:24:04
Определить активный textbox
Пользователь
Сообщений: Регистрация: 18.01.2013
23.12.2015 09:19:50
Уважаемые профи, подскажите пожалуйста, можно ли решить данный вопрос. Ситуация такая. На форме имеются 2 текстбокса и кнопка. Как сделать так, чтобы если я выберу 1 текстбокс нажатие кнопки приводило к его заполнению скажем числом 123, а если я выбираю 2-ой текстбокс, то нажатие той же кнопки помещало тоже самое число 123 уже во второй текстбокс. Что-то типа:
Код
Private Sub CommandButton1_Click()
if задействован textbox1 Then
me.textbox1 = 123
elseif задействован textbox2 Then
me.textbox2 = 123
end if
End Sub
В реальном файле предполагается использовать 1 календарь для ввода в текстбоксы начальной и конечной дат отчета (разумеется можно сделать 2 календаря, но ведь это, как я понимаю, неправильно, а если бы текстбоксов на форме было 100?). Пытался найти свойства в текстбоксе типа activate, но не смог. Подскажите можно ли решить данный вопрос. Заранее спасибо всем откликнувшимся.
P.S. Вариант именно с текстбоксом непринципиален, если нужные свойства можно использовать у др. объектов (листбокc или label), то тоже подойдет, в любом случае в коде задумывается простое сравнение с введенным значением и последующий перенос значения на лист
Выгрузка массива на лист
Пользователь
Сообщений: Регистрация: 18.01.2013
22.12.2015 14:06:46
Уважаемые профи форма, подскажите как можно решить данную проблему. На листе Поступление+реализация по нижеприведенному коду происходит выгрузка данных
Код
Private Sub CommandButton1_Click()
Dim FirstRow As Long, LastRow_p As Long, LastRow_r As Long, i As Long
LastRow_p = Sheets("Приход").Cells(Rows.Count, [Tovar_prihoda].Column).End(xlUp).Row
LastRow_r = Sheets("Расход").Cells(Rows.Count, [Tovar_rashoda].Column).End(xlUp).Row
FirstRow = 8
For i = 2 To LastRow_p
If CDate(Sheets("Приход").Cells(i, [Data_dokumenta_prihoda].Column)) >= [E5] And CDate(Sheets("Приход").Cells(i, [Data_dokumenta_prihoda].Column)) <= [G5] Then
Cells(FirstRow, 1) = Sheets("Приход").Cells(i, [Nomer_dogovora].Column)
Cells(FirstRow, 2) = Sheets("Приход").Cells(i, [Data_dokumenta_prihoda].Column)
Cells(FirstRow, 3) = Left(Sheets("Приход").Cells(i, [Komit].Column), Application.Find(" ", Sheets("Приход").Cells(i, [Komit].Column)) + 1) & "." & Mid(Sheets("Приход").Cells(i, [Komit].Column), Application.Find(" ", Sheets("Приход").Cells(i, [Komit].Column), Application.Find(" ", Sheets("Приход").Cells(i, [Komit].Column)) + 1) + 1, 1) & "."
Cells(FirstRow, 4) = Sheets("Приход").Cells(i, [Tovar_prihoda].Column)
Cells(FirstRow, 5) = Sheets("Приход").Cells(i, [Col_prihoda].Column)
Cells(FirstRow, 6) = Sheets("Приход").Cells(i, [Cena_komit].Column)
Cells(FirstRow, 7) = Sheets("Приход").Cells(i, [Cena_rozn].Column)
Cells(FirstRow, 8) = Sheets("Приход").Cells(i, [Col_prihoda].Column) * Sheets("Приход").Cells(i, [Cena_komit].Column)
FirstRow = FirstRow + 1
End If
Next
...
...
End Sub
Все данные отбираются правильно и оказываются в правильных ячейках, НО в реальном файле данных, из которых происходит отбор, имеется несколько тысяч строк в результате чего выгрузка длится несколько минут, что нехорошо. В сети я встречал совет предварительно отбирать данные в массив, а затем выгружать этот полученный массив целиком на лист, но как это сделать понять не смог. Покажите пожалуйста на моем примере как это делается, например для 1 цикла, а далее, надеюсь, и моих мозгов хватит. Заранее спасибо всем откликнувшимся.
Последовательные циклы: оптимизация кода при заполнении 3-х столбцов
Пользователь
Сообщений: Регистрация: 18.01.2013
14.12.2015 14:22:28
Уважаемые профи форума, подскажите пожалуйста, можно ли исправить недостатки текущего кода. Ситуация такая. На листе имеется шаблон состоящий из 3-х столбцов, а также листбокс на форме, данными с которого и заполняются эти столбцы. Поскольку у меня должны заполниться 3 столбца, циклов для их заполнения пришлось делать тоже 3 с шагом =3. Выглядит это так:
Код
Private Sub BigSize_Click()
Dim i As Integer, j As Integer, k As Integer, x As Integer, y As Integer, FIO_ruk As String, LastRow As Long
FIO_ruk = "Иванов И.И."
With Sheets("Ценники")
On Error Resume Next
' .Visible = True 'отображение листа
Columns("A:N").ClearContents
For i = 2 To 602 Step 6 'установка высоты строк и размеров шрифта
.Rows(i).RowHeight = 96
.Rows(i).Font.Size = 20
Next
x = 2
y = 4
For i = 0 To Me.Tovar_reestra.ListCount - 1 Step 3
If Me.Tovar_reestra.Selected(i) Then
.Cells(x - 1, 1) = FIO_ruk ' шапка
.Cells(x, 1) = Tovar_reestra.List(i, 0) 'наименование товара
.Cells(y, 1) = Tovar_reestra.List(i, 1) 'цена товара
.Cells(y, 2) = "руб." 'шапка
.Cells(y, 3) = "за" 'шапка
.Cells(y, 4) = Tovar_reestra.List(i, 2) 'ед. измерения
x = x + 6
y = y + 6
End If
Next
x = 2
y = 4
For j = 1 To Me.Tovar_reestra.ListCount - 1 Step 3
If Me.Tovar_reestra.Selected(j) Then
.Cells(x - 1, 6) = FIO_ruk
.Cells(x, 6) = Tovar_reestra.List(j, 0)
.Cells(y, 6) = Tovar_reestra.List(j, 1)
.Cells(y, 7) = "руб."
.Cells(y, 8 = "за"
.Cells(y, 9) = Tovar_reestra.List(j, 2)
x = x + 6
y = y + 6
End If
Next
x = 2
y = 4
For k = 2 To Me.Tovar_reestra.ListCount - 1 Step 3
If Me.Tovar_reestra.Selected(k) Then
.Cells(x - 1, 11) = FIO_ruk
.Cells(x, 11) = Tovar_reestra.List(k, 0)
.Cells(y, 11) = Tovar_reestra.List(k, 1)
.Cells(y, 12) = "руб."
.Cells(y, 13) = "за"
.Cells(y, 14) = Tovar_reestra.List(k, 2)
x = x + 6
y = y + 6
End If
Next
LastRow = Application.Max(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row + 1, ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Row + 1)
Range("$A$1:N" & LastRow).PrintOut Copies:=1, Collate:=True
' .Visible = False
End With
Unload Me
End Sub
Теперь вопрос: во-первых (чисто для знаний) хотелось бы узнать можно ли решить задачу заполнения 3 столбцов иным способом (не 3 циклами) и вообще оптимизировать текущий код. А главное можно ли и как исправить следующий недочет: если выбрать например 1, 4, 7, 10, 13, 16 позиции в листбоксе, т.е. позиции которые отслеживает 1-й цикл, то все отобразится и распечатается правильно, но останутся незаполненными 2 и 3 столбец и фактически попытка экономии бумаги (именно для этого распечатывается не какое-то кол-во страниц, а область: Range("$A$1:N" & LastRow).PrintOut) не будет реализована. Вычисление MAX при расчете LastRow сделано именно на тот случай, если скажем во 2 (или 3) столбце данных окажется больше чем в 1 и расчет по первому столбцу окажется неверным. .
Иными словами, можно ли организовать цикл так, чтобы не найдя соответствия для своей переменной, цикл продолжил поиски в листбоксе для параметров другой переменной? Типа: код проверяет соответствие для переменной i=0, если не находит, то сначала проверяет соответствие для j=1 и k=2, А уж затем ищет соответствие для следующего значения i, т.е. i=3 ну и т.д. Прошу простить, если предполагаю полную ерунду. Заранее спасибо всем откликнувшимся.
СУММПРОИЗВ в коде VBA
Пользователь
Сообщений: Регистрация: 18.01.2013
05.12.2015 20:08:04
Уважаемые профи форума, подскажите как можно заменить правильно считающую функцию СУММЕСЛИМН на СУММПРОИЗВ в том же месте кода. Ситуация такая. Имеется следующий код:
Код работает правильно, данные в .List(x, 1) , .List(x, 2), .List(x, 3) разумеется не фиксированные, а вычисляемые (не привожу кода, чтобы не загромождать сообщение, но считается все правильно). Возник вопрос, можно ли заменить в коде SumIfs на SumProduct. Формулой, в ячейке листа, получилось без проблем:
разумеется, в ячейке F2 находится номер документа, в ячейке D2 находится дата, в ячейке С2 - указана секция, имена и размеры диапазонов правильные. Повторюсь, формула считает правильно. А вот как сделать то же самое в в приведенном коде, я пока не знаю. Как должна выглядеть функция SumProduct в коде VBA? Заранее спасибо всем откликнувшимся.
Найти последнюю заполненную ячейку не открывая файл
Пользователь
Сообщений: Регистрация: 18.01.2013
04.12.2015 19:38:50
Уважаемые профи форума ,подскажите, можно ли решить данную проблему. Ситуация такая. Для указания на файл в котором содержатся данные подлежащие импорту, использую функция, найденную на просторах сети:
Код
Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", Optional ByVal InitialPath, Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String
If Not IsMissing(InitialPath) Then
On Error Resume Next: ChDrive Left(InitialPath, 1)
ChDir InitialPath
End If
res = Application.GetOpenFilename(MyFilter, , Title, "Открыть")
GetFileName = IIf(VarType(res) = vbBoolean, "", res)
End Function
получение данные (в прилагаемом файле "Данные") предполагается осуществить следующим кодом:
Код
Sub Import_data()
Dim FileName As String, OpenFileName As String, OpenPathName As String, LastRow_p As Long, LastRow_data As Long, Colpoz As Integer
LastRow_p = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row + 1
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If MsgBox("Вы уверены, что правильно подготовили файл с данными для импорта?" & vbCrLf & _
"Лист, на котором расположены данные, называется 1" & vbCrLf & _
"Данные с наименованием товара должны начинаться с ячейки B1" & vbCrLf & _
"Данные с единицами измерения должны начинаться с ячейки C1" & vbCrLf & _
"Данные с ценой должны начинаться с ячейки D1", vbCritical + vbYesNo, "Внимание! Подумайте перед ответом") = vbYes Then
FileName = GetFileName("Укажите ПОДГОТОВЛЕННЫЙ файл для импорта данных", ThisWorkbook.Path) 'запрашиваем имя файла
If FileName = "" Then Exit Sub 'выход, если пользователь отказался от выбора файла
OpenPathName = Left(FileName, InStrRev(FileName, "\"))
OpenFileName = Mid(FileName, InStrRev(FileName, "\") + 1)
LastRow_data = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
MsgBox LastRow_data
End If
Cells(LastRow_p, 8).FormulaR1C1 = "='" & OpenPathName & "[" & OpenFileName & "]1'!R1C2"
Cells(LastRow_p, 9).FormulaR1C1 = "='" & OpenPathName & "[" & OpenFileName & "]1'!R1C3"
Cells(LastRow_p, 11).FormulaR1C1 = "='" & OpenPathName & "[" & OpenFileName & "]1'!R1C4"
' Cells(Cells(LastRow_p, 8), Cells(LastRow_p, 11)).AutoFill Destination:=Cells(Cells(LastRow_p, 8), Cells(LastRow_data, 11)), Type:=xlFillDefault
' Cells(Cells(LastRow_p, 8), Cells(LastRow_data, 11)).Value = Cells(Cells(LastRow_p, 8), Cells(LastRow_data, 11)).Value
' MsgBox "Данные из указанного файла успешно импортированы", vbInformation, "Импорт данных"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
данные в соответствующие ячейки вставляются правильно (можно убедиться нажав кнопку), но затем необходимо "протянуть" формулу на какое-то число строк вниз, а именно на количество строк в импортируемом файле. А вот как вычислить это число, не открывая файл я пока не знаю. Имеющаяся конструкция типа:
дает неправильный ответ (1, а не 38). Можно ли, используя функцию, или каким либо иным образом вычислить последнюю заполненную ячейку в файле "Данные", не открывая сам файл, ведь данные с помощью функции выбираются правильно, значит доступ к содержимому файла можно получить? Можно конечно это самое число запросить у пользователя через InputBox, но этот вариант я пока оставил запасным. Заранее спасибо всем откликнувшимся.
Найти разрыв страницы в указанном диапазоне
Пользователь
Сообщений: Регистрация: 18.01.2013
25.11.2015 17:49:50
Уважаемые профи форума Подскажите как исправить код. Имеется правильно работающий код для расчета постраничного итога при предпечатной обработке:
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim i As Integer, j As Integer, sum_page As Double
If ActiveSheet.Name = "Приход+расход за месяц" Then
With Sheets("Приход+расход за месяц")
.[G14:G302].ClearContents
If .HPageBreaks.Count = 1 Then 'для 1 страницы прихода и 1 страницы расхода и 1 страницы расхода
Cells(Cells(Application.Max(.[B14:B184]), 2).Row + 13, 7) = "Итого по стр. " & Format(Application.Sum(Range(Cells(14, 6), Cells(Cells(13 + Application.Max(.[B14:B184]), 2).Row, 6))), "0.00")
Cells(Cells(Application.Max(.[B191:B302]), 2).Row + 190, 7) = "Итого по стр. " & Format(Application.Sum(Range(Cells(191, 6), Cells(Cells(190 + Application.Max(.[B191:B302]), 2).Row, 6))), "0.00")
Else
Cells(Application.Max(.Range(Cells(14, 2), Cells(.HPageBreaks(1).Location.Row, 1))) + 12, 7) = _
"Итого по стр.1 " & Format(Application.Sum(Range(Cells(14, 6), Cells(Application.Max(.Range(Cells(14, 2), Cells(.HPageBreaks(1).Location.Row, 1))) + 12, 6))), "0.00")
Cells(Application.Max(.Range(Cells(191, 2), Cells(.HPageBreaks(5).Location.Row - 1, 1))) + 190, 7) = _
"Итого по стр.1 " & Format(Application.Sum(Range(Cells(191, 6), Cells(Application.Max(.Range(Cells(191, 2), Cells(.HPageBreaks(5).Location.Row - 1, 1))) + 190, 6))), "0.00")
For i = 1 To 2
sum_page = Application.Sum(Range(Cells(.HPageBreaks(i).Location.Row, 6), Cells(.HPageBreaks(i + 1).Location.Row - 1, 6)))
Cells(Application.Max(.HPageBreaks(i).Location.Row - 1, .HPageBreaks(i + 1).Location.Row - 1), 7) = "Итого по стр. " & i + 1 & " " & Format(sum_page, "0.00")
Next i
For j = 4 To 5
sum_page = Application.Sum(Range(Cells(.HPageBreaks(j).Location.Row, 6), Cells(.HPageBreaks(j + 1).Location.Row - 1, 6)))
Cells(Application.Max(.HPageBreaks(j).Location.Row - 1, .HPageBreaks(j + 1).Location.Row - 1), 7) = "Итого по стр. " & j + 1 & " " & Format(sum_page, "0.00")
Next j
Cells(Cells(Application.Max(.[B14:B184]), 1).Row + 13, 7) = _
"Итого по стр." & i + 1 & " " & Format(Application.Sum(Range(Cells(.HPageBreaks(i).Location.Row, 6), Cells(184, 6))), "0.00")
Cells(Cells(Application.Max(.[B191:B302]), 1).Row + 190, 7) = _
"Итого по стр." & j + 1 & " " & Format(Application.Sum(Range(Cells(.HPageBreaks(j).Location.Row, 6), Cells(302, 6))), "0.00")
End If
End With
End If
End Sub
Все работает как и задумывалось, но есть небольшое одно НО: код отрабатывает правильно, только если заполнены 4 страницы прихода. В таком случае указанная
Код
Cells(.HPageBreaks(5)
граница для расчета диапазона является правильной (3 разрыва в данных прихода + вручную указанный разрыв между приходом и расходом). А вот если листов в приходе будет 2 или 3 (для 1 листа прихода и 1 листа расхода код прописан отдельно) VBA просто не может найти 5 разрыв страницы (или найдет его неправильно) и выпадает с ошибкой. Как это исправить и указать в качестве координат не 5 разрыв, а 1-ый разрыв ниже указанной ячейки, скажем А186. Строк в итоговом отчете может быть любое количество (в пределах указанного), но пустые строки скрываются, так что адрес первой ячейки расхода (в примере А186) не изменится. В прилагаемом примере код отрабатывает правильно, но если убрать данные с листа 4 (скажем до 150 позиции и скрыть освободившиеся строки) возникнет вышеизложенная проблема. Заранее спасибо всем откликнувшимся.
Изменено: - 25.11.2015 18:17:24
Обойти ограничение на длину формулы, Нельзя установить свойство formulaarray класса range
Пользователь
Сообщений: Регистрация: 18.01.2013
22.11.2015 15:46:45
Уважаемые профи форума, подскажите, можно ли каким либо способом обойти ограничения Excel. Ситуация такая в ячейках имеются правильно работающие формулы массива длина которых варьируется от ~500 до ~ 750 символов. Повторюсь, формулы считают правильно. Для возможности восстановления формул при необходимости, я записал их макрорекодером. Но при попытке запустить макрос выпадает ошибка Нельзя установить свойство formulaarray класса range. Если я правильно понимаю совет с темы , то у меня такая же ситуация как и у автора темы, а именно превышение длины формулы. Сократить формулу, причем более чем в 2 раза нереально. Вопрос таков: можно ли каким либо образом обойти вышеупомянутое ограничение формулы или другим способом иметь возможность восстановить формулу в ячейках длина которой превышает 255 знаков? Заранее спасибо всем откликнувшимся.
Как переиндексировать уже найденное значение формулы массива?, ИНДЕКС к вычисленному ИНДЕКСу
Пользователь
Сообщений: Регистрация: 18.01.2013
20.11.2015 16:32:36
Уважаемые профи форума, подскажите можно ли решить возникшую проблему. В файле имеются 3 листа: Приход, Расход, Остатки с соответствующими их именам данными. На листе Приход в одной из ячеек формулам вычисляется текущий остаток товара (все правильно), но данные по остаткам могут потребоваться на некую "промежуточную" дату, т.е. текущий остаток может уже равняться 0, но ведь на дату за несколько дней до последнего расхода остаток, разумеется был положительным. Данные по остатку товара являются главным критерием для остатков (нет смысла отображать данные для товара, который уже потрачен). Эти промежуточные данные по остаткам на произвольную дату также реализованы формулой на листе Приход. А теперь наконец-то вопрос: можно ли и как реализовать расчет остатков на произвольную дату на листе Остатки, а колонку на листе Приход удалить? Пока у меня получилось следующее: правильно вычисляется остаток товара на указанную дату, эти данные корректно используются при отборе данных (в столбце наименования товара на листе остатков). Все бы хорошо, но данные по наименованию (а по аналогии и прочие) формулой ИНДЕКС и НАИМЕНЬШИЙ как и задумано не показывают данные при невыполнении главного условия (положительного остатка на дату), а вот сами остатки (правильно вычисленные!) не индексируются и, соответственно, иногда отображаются некорректно. Другими словами, если в прилагаемом примере указать дату 12/11, то все будет правильно (2 позиции наименования остатков, верные остатки), но вот если выбрать дату 20/11, то из наименований останется только одно (и это правильно), а вот остатки (правильно вычисленные) будут отображаться как 0 и 9 и соответственно для правильно отобранного значения наименований будет отображаться неверный остаток. Я предположил, что полученные данные остатков надо тоже как либо проиндексировать (чтобы не отображались при нулевых результатах), но вот как сделать не знаю. Описание получилось длинным, но надеюсь понятным. Все формулы на прилагаемом файле. Заранее спасибо всем откликнувшимся.
Поиск в диапазоне ячейки с ошибкой, По аналогии с поиском последней заполненной ячейки найти в диапазоне ячейку с ошибкой
Пользователь
Сообщений: Регистрация: 18.01.2013
18.11.2015 17:11:01
Уважаемые профи форума, проконсультируйте на 2 вопроса. Ситуация такая. Нетрудно найти последнюю заполненную ячейку в диапазоне:
Код
ActiveSheets.Cells(Rows.Count, 1).End(xlUp).Row
Далее мы имеем диапазон, заполненный данными формулы массива, большая часть из которых в силу условий формулы имеют значение #Н/Д. При попытке организовать цикл с проверкой на условие по этому диапазону код выпадает на первой же ячейке с ошибкой. Сейчас я решил эту проблему предварительной проверкой ячейки:
Код
If Not Application.WorksheetFunction.IsError(ячейка.Value) Then
все работает правильно, а вопрос такой. Можно ли по аналогии с поиском последней заполненной ячейки найти в диапазоне первую ячейку с ошибкой и соответственно указать цикл с 1 ячейки по 1 ячейку с ошибкой -1. Можно ли сделать так и будет ли это более правильным по сравнению с моим кодом? И еще один вопрос по формуле массива, как правильнее: указать диапазон для формулы массива на 5000 ячеек сразу как диапазон с 1 по 5000 ячейку или сначала формулой найти последнюю ячейку с результатом и указать формуле массива размер с 1 ячейки диапазона до найденной ячейки?
Снять фокус с UserForm
Пользователь
Сообщений: Регистрация: 18.01.2013
12.10.2015 10:33:24
Уважаемые профи форума, подскажите причину разного поведения UserForm и способ устранения возникшей проблемы. Задумывалось: при активации листа форма (запущенная модально) появляется и висит в указанном месте, не мешая пользователю работать с документом и отображая итоговую информацию. Все это у меня вроде получилось, но: если форма запускается с кнопки:
Код
Private Sub CommandButton1_Click()
UserForm1.Show 0
[a1].Activate
End Sub
то все в порядке, можно сразу вводить текст в ячейку А1. А вот, если форма запускается при активации страницы:
Код
Private Sub Worksheet_Activate()
UserForm1.Show 0
[a1].Activate
End Sub
то фокус остается на ней и для ввода информации следует сначала выбрать ячейку. Можно ли это исправить и сделать так, чтобы фокус уходил с формы, активизируя какую-либо ячейку, словом как в варианте с кнопкой? В свойствах формы ShowModal = False, впрочем в любом случае, форма в обоих вариантах используется одна и та же. Или это какое-либо ограничение свойств формы и задуманное не реализуемо? Заранее спасибо всем откликнувшимся.
Отображаются не все столбцы в Listbox, Ошибка could not set the list property invalid property value
Пользователь
Сообщений: Регистрация: 18.01.2013
10.10.2015 19:58:58
Уважаемые профи, подскажите еще раз. Вот не зря в правилах не разрешается поднимать 2 вопроса в 1 теме. Я попробовал, на первую часть ответили за что еще раз спасибо, а на вторую никак (впрочем какие претензии - и не по правилам, и в заголовке об этом не слова ) Ситуация такая: на форме имеется listbox на 13 столбцов (Data.ColumnCount = 13), сейчас для краткости кода они заполнены тестовыми значениями. Но заполняются только столбцы с 0 по 10, почему, ведь и количество столбцов указано и их ширина, а значений нет. Если снять комментарий со строки
Код
' On Error GoTo 0
то код выпадает с ошибкой could not set the list property invalid property value. Что в моем коде не так и как это исправить? Заранее спасибо всем откликнувшимся.
Код
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim LastRow_p As Long
LastRow_p = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
Me.Data.ColumnCount = 13
Me.Data.ColumnWidths = "170;42;42;42;42;42;42;42;42;42;42;42;42"
Set AllCells = Sheets("Выплаты комитентам").Range(Cells(8, 2), Cells(LastRow_p, 2))
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
' On Error GoTo 0
With Me.Data
.Clear
For Each Item In NoDupes
.AddItem 123
.List(.ListCount - 1, 1) = Format(1234, "0.00")
.List(.ListCount - 1, 2) = Format(1234, "0.00")
.List(.ListCount - 1, 3) = Format(1234, "0.00")
.List(.ListCount - 1, 4) = Format(1234, "0.00")
.List(.ListCount - 1, 5) = Format(1234, "0.00")
.List(.ListCount - 1, 7) = Format(1234, "0.00")
.List(.ListCount - 1, 8) = Format(1234, "0.00")
.List(.ListCount - 1, 9) = Format(1234, "0.00")
.List(.ListCount - 1, 10) = Format(1234, "0.00")
.List(.ListCount - 1, 11) = Format(1234, "0.00")
.List(.ListCount - 1, 12) = Format(1234, "0.00")
Next
End With
End Sub
Использование SUMIFS в коде VBA, Неверно считает функция
Пользователь
Сообщений: Регистрация: 18.01.2013
10.10.2015 16:36:17
Уважаемые гуру форума, помогите решить возникший вопрос. Ситуация такая: пытаюсь создать аналог таблицы на листе с выборкой данные по месяцам (в ней все считается верно) на UserForm. Для этого воспользовался кодом от ZVI:
Код
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim LastRow_p As Long
LastRow_p = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
Me.Data.ColumnCount = 13
Me.Data.ColumnWidths = "170;42;42;42;42;42;42;42;42;42;42;42;42"
Me.God = Year(Date)
Set AllCells = Sheets("Выплаты комитентам").Range(Cells(8, 2), Cells(LastRow_p, 2))
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
' On Error GoTo 0
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
With Me.Data
.Clear
For Each Item In NoDupes
.AddItem Item
...
.List(.ListCount - 1, 5) = _
Format(WorksheetFunction.SumIfs(Range(Cells(8, 4), Cells(102, 4)), Range(Cells(8, 2), Cells(102, 2)), Item, Range(Cells(8, 1), Cells(102, 1)), ">=" & DateValue("1 " & MonthName(5) & " " & God), Range(Cells(8, 1), Cells(102, 1)), "<=" & DateValue("1 " & MonthName(6) & " " & God)), "0.00")
.List(.ListCount - 1, 9) = Format(1234, "0.00")
.List(.ListCount - 1, 10) = Format(1234, "0.00")
...
Next
End With
End Sub
уникальные записи комитентов вычисляются правильно, для заполнения 2-го и последующих столбцов по аналогии с записанным макросом формулой пытаюсь использовать функцию SumIfs. Сам код не ругается, просмотренные через пошаговое исполнение данные тоже вроде правильные, а вот вычисляется 0 (вместо 1090 для первой строки 2-го столбца например). Что пока в коде не так? И еще один вопрос по этому же коду: почему не отображаются данные (тестовые) в столбцах с 10 по 12, ведь количество столбцов указано? А если снять комментарий к строке :
Код
' On Error GoTo 0
то код выпадает с ошибкой could not set the list property invalid property value. Прошу указать на причину этой ошибки
Код VBA не работает в windows 10
Пользователь
Сообщений: Регистрация: 18.01.2013
05.10.2015 09:36:28
Уважаемые гуру форума, подскажите, может ли это быть правдой. Имеется код, найденный на просторах сети:
Код
Function ExtractUniqueSort(DRange As Variant) As Variant 'Автоматическое извлечение уникальных данных из выбранного диапазона с сортировкой
Dim Data As Object, i As Long, j As Long, NumRows As Long, NumCols As Long
If TypeName(DRange) = "Range" Then DRange = DRange.Value2
NumRows = UBound(DRange)
NumCols = UBound(DRange, 2)
Set Data = CreateObject("System.Collections.ArrayList")
For i = 1 To NumCols
For j = 1 To NumRows
If Len(DRange(j, i)) Then
If Not Data.Contains(DRange(j, i)) Then Data.Add DRange(j, i)
End If
Next j
Next i
Data.Sort
ExtractUniqueSort = Application.Transpose(Data.toarray)
End Function
все работало до того как я решил попробовать новую ОС Windows 10, выяснив, что этот код не желает работать в новой windows. В доказательство привожу 2 скрина с виртуальных машин. Не первой, где код работает, установлен Windows 7 x64 + Office 2016. На второй, где код соответственно не работает, установлен Windows 10 x64 + Office 2016. Англоязычный интерфейс на второй машине получился из-за моего недогляда при инсталляции , но дистрибутив офиса и исходный файл использовался один и тот же. На реальной машине сейчас установлен Windows 10 x64 + office 2013 и код не работает (до перестановки был Windows 7 x64 + Office 2013), так что дело вряд ли в новой версии офиса. А вопрос чисто теоретический: может ли вышеизложенное быть правдой и код не работать из-за особенностей новой ОС и ли все дело в недостаточно прямых моих руках?
MsgBox с информацией о сумме отфильтрованных ячеек
Пользователь
Сообщений: Регистрация: 18.01.2013
01.10.2015 19:21:08
Уважаемые форумчане, подскажите как можно решить данную проблему. Ситуация такова: на листе имеются данные по выплатам и 2 combobox при изменении которых данные фильтруются либо по дате, либо по комитенту (все работает вроде правильно, хотя если кто-то решить поправить код, буду только раз увидеть Ваш вариант). А требуется, чтобы по изменению combobox данные сначала отфильтровывались, затем выводился MsgBox с информацией о сумме отфильтрованных ячеек (из столбца D), а затем данные вновь принимали первоначальный вид (снимался фильтр). Последнее конечно я и сам смогу сделать (собственно кнопками это реализовано уже сейчас), а вот как подсчитать сумму в ОТФИЛЬТРОВАННЫХ ячейках я не знаю. В принципе, если более красивого решения нет, меня устроит вариант подсчета суммы в какой-либо неиспользуемой ячейке формулами с последующим выводом информации в MsgBox, но хотелось бы обойтись без этого, так как про шаловливые ручки пользователя забывать не след. Заранее спасибо всем тем кто откликнется.
Недостаточная точность умножения массивов
Пользователь
Сообщений: Регистрация: 18.01.2013
21.08.2015 16:56:35
Уважаемые форумчане, совсем недавно я обращался за помощью к вам по вопросу выборки данных без предварительного занесения данных на лист и мне была оказана помощь, за что еще раз выражаю благодарность. Но возник еще небольшой вопрос: потребовалось дополнительно подсчитать данные аналогично функции СУММПРОИЗВ. Это я смог реализовать так:
Код
[/CODE][CODE]itogo = 0
For x = 17 To 116
itogo = itogo + arr(i, x) * arr(6, x)
Next
Код полностью:
Код
Private Sub DataFromExcel(sh As Worksheet)
Dim arr(), lr As Long, i As Long, x As Long, itogo As Long
lr = sh.Columns("D").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
arr() = sh.Range("D1:DO" & lr).Value
With Me.Spisok_listov
For i = 11 To 25
itogo = 0
For x = 17 To 116
itogo = itogo + arr(i, x) * arr(6, x)
Next
If arr(i, 1) > 0 Then .AddItem arr(i, 1)
...
.List(.ListCount - 1, 4) = Format(itogo, "0.00")
Next
End With
End Sub
затем вывожу результат в столбец Listbox, считает ПОЧТИ правильно и все ОК. НО почему-то результат выводится округленным, например в первой строке должен быть результат 17897,50 (19,5*85), а выводится 17898,00. Почему так я понять не могу. Пошагово проверяю код, все верно, используются правильные значения (в arr(i, x) и arr(6, x)), а результат все равно округляется. Подскажите что надо поправить? Заранее спасибо всем откликнувшимся.
Изменено: - 21.08.2015 16:57:20
Использовать массив для заполнения listbox
Пользователь
Сообщений: Регистрация: 18.01.2013
14.08.2015 10:09:49
Уважаемые форумчане, подскажите как решить проблему. Задумка такая: имеется listbox который заполняется методом Item:
Код
For i = 1 To ThisWorkbook.Sheets.Count
n = Sheets(i).Name
If n <> "Лист4" Then Me.ListBox1.AddItem (n)
Next i
требуется, чтобы по нажатию кнопки выделенные элементы попали бы в массив (эту часть, надеюсь правильно, я смог написать сам):
Код
Dim i As Long
Dim lcnt As Long
Dim avArr()
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ReDim Preserve avArr(lcnt)
avArr(lcnt) = CStr(ListBox1.List(i))
End If
Next
GetItemText = avArr
Me.ListBox1.Clear
Затем Listbox очищается и дальше ... только моя идея, а идея такая: Listbox должен заполниться данными с отмеченных листов, так же как это сделано формулой в ячейке С8 на листе4, т.е. в 1 строке 1 колонка Listbox должна отображать первую работу на 1 отмеченном листе (по идее разумеется 2 колонка 1 строки - количество работ), далее вторую работу и количество 1 отмеченного листа (кстати, этих работ может быть максимум 15), затем, разумеется, все тоже самое для 2 отмеченного листа и т.д.. Как это сделать я не знаю, если конечно это вообще реальный и разумный способ. Сейчас выбранные данные сначала вставляются на лист, а затем анализируются я бы хотел попробовать избежать вставки. Заранее спасибо тем кто откликнется.
Отследить способ активации userform
Пользователь
Сообщений: Регистрация: 18.01.2013
07.08.2015 16:41:04
Уважаемые форумчане, возможно ли отследить через какое событие на листе была вызвана пользовательская userform. Ситуация такая имеются 2 userform со списком листов книги (список одинаковый, источник для Listbox задан в настройках), по клику в listbox 1 формы происходит перемещение на выбранный лист, по клику на listbox 2 формы происходит вставка выбранного значения в указанную ячейку активного листа. А я хочу попытаться объединить функционал 2-х форм в 1. Сейчас, на 2 формах все работает, так что, если задача не решается, то ни разу страшного не произойдет. Подытоживая, задача следующая: одна форма появляется при активации листа, другая при клике правой клавишей мыши, необходимо научить форму понимать эту разницу. Заранее спасибо всем кто откликнется
Использование функции СУММПРОИЗВ в коде VBA
Пользователь
Сообщений: Регистрация: 18.01.2013
31.03.2014 14:27:28
Уважаемые гуру форума. Помогите решить небольшую проблему. Сейчас на листе, с целью недопущения перерасхода при вводе, имеется формула =ЕСЛИ(СУММПРОИЗВ((B$10=$B$10:$E$10)*(B$6=$B$6:$E$6)*(B$4=$B$4:$E$4)*$B$11:$E$13)>B$5;"есть";"нет")
в коде VBA на данной странице проверяется наличие слова "есть" (т.е. фактически наличие перерасхода), стирается последнее введенное значение и выводится MsgbOX с сообщением о перерасходе:
Код
Dim s As Range
For Each s In ActiveSheet.Range("B7:E7")
If s = "есть" Then
ActiveCell.Offset(-1, 0).ClearContents
MsgBox "Вы превысили остаток!"
End If
Next
Все работает как надо, но сейчас я задумался о том, чтобы на всякий случай убрать формулы проверки превышения остатка с листа, подальше от шаловливых рук пользователя. Но когда я попытался перенести имеющуюся формулу в VBA, то столкнулся с проблемой:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
dRow = 4
kRow = 5
cRow = 6
nRow = 10
aColumn = ActiveCell.Column
's = WorksheetFunction.SumProduct((Cells(nRow, aColumn)) = Range(Cells(10, 2), Cells(10, 5))) * (Cells(cRow, aColumn) = Range(Cells(6, 2), Cells(6, 5))) * (Cells(dRow, aColumn) = Range(Cells(4, 2), Cells(4, 5))) * Range(Cells(11, 2), Cells(13, 5))
's = Application.WorksheetFunction.SumProduct((Cells(nRow, aColumn)) = Range("B10:E10") * (Cells(cRow, aColumn) = Range("B6:E6") * (Cells(dRow, aColumn) = Range("B4:E4") * Range("B11:E13"
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B7:E7") Is Nothing Then
If s > Cells(kRow, aColumn) Then
ActiveCell.Offset(-1, 0).ClearContents
MsgBox "Вы превысили остаток!"
End If
End If
End Sub
Ячейку, с которой сравнивается диапазон (вместо фиксированной B$10), я смог вычислить (Cells(nRow, aColumn) дает правильное значение), но сама функция нахождения СУММПРОИЗВ вылетает с ошибкой 13. Что мне надо поправить в строке нахождения переменной s (надеюсь в остальном код правильный). Сейчас обе мои попытки закомментированы. Заранее спасибо всем откликнувшимся.
Изменено: - 31.03.2014 14:28:06
определение адреса ячейки
Пользователь
Сообщений: Регистрация: 18.01.2013
19.03.2014 12:10:35
Уважаемые гуру форума, вынужден повторно обратиться к Вам за помощью и советом. В теме "Как определить адрес ячейки через VBA" я спрашивал о нахождении адреса ячейки:
Цитата
При деактивации листа данные 1 конкретной ячейки (G46) должны попасть в таблицу, находящуюся на другом листе, причем если на искомом листе проводился документ за январь, то данные в таблице должны попасть в ячейку напротив января ну и так далее конечно
и мне были даны ответы которые меня полностью устроили, в частности варианты от ikki
Код
Private Sub Worksheet_Deactivate()
Sheets("Запчасти").[u:u].find(format([d9],"MMMM")).offset(,5).value=[g46].value
End Sub
или
Код
Private Sub Worksheet_Deactivate()
set r=Sheets("Запчасти").[u:u].find(format([d9],"MMMM"))
if not r is nothing then r.offset(,5).value=[g46].value
End Sub
Но далее я задумал сделать файл не на 1 год использования, а на несколько, для этого в столбце U таблицы теперь находятся данные типа "январь41640". т.е. сцепка названия месяца и текущего года. Данные в таком же формате я могу получить и на искомом листе (=СЦЕПИТЬ($D$9;$E$9), а вот как видоизменить формулу от ikki, заменив
Код
find(format([d9],"MMMM"))
на новый формат никак не могу придумать. Самонадеянно пробовал такую конструкцию:
Код
Find(Range("C9", "D9").Consolidate)
но выдает ошибку '1004' Меня устроил бы вариант в котором сначала в какой-то свободной ячейке проходила сцепка, а потом полученное значение искалось бы в таблице если метод .Consolidate в такой ситуации не работает или работает не так как надо. Как следует исправить эту полностью работающую в прежнем варианте строку? Заранее спасибо всем откликнувшимся
Как определить адрес ячейки через VBA
Пользователь
Сообщений: Регистрация: 18.01.2013
11.03.2014 09:50:46
Уважаемые гуру форума, подскажите как решить данный вопрос. При деактивации листа данные 1 конкретной ячейки должны попасть в таблицу, находящуюся на другом листе, причем если на искомом листе проводился документ за январь, то данные в таблице должны попасть в ячейку напротив января ну и так далее конечно. Как вычислить адрес этой самой ячейки на нужном листе я вроде бы придумал:
адрес вычисляется правильно, я проверял. Но вот как указать этот адрес в коде VBA:
Код
Private Sub Worksheet_Deactivate()
Range("G46").Copy
Sheets("Запчасти").Cells(???).PasteSpecial Paste:=xlPasteValues
End Sub
именно в описании Cell, я пока никак не могу понять. Заранее спасибо всем откликнувшимся.
Выделение динамического диапазона
Пользователь
Сообщений: Регистрация: 18.01.2013
03.03.2014 13:22:03
Уважаемые гуру форума, как выделить (для последующей обработки) в известном диапазоне начиная с "контрольной ячейки" (адрес которой известен точно) до последней заполненной ячейки указанной строки. В примере в дипазоне А1:J3 начиная с ячейки А1 и заканчивая ячейкой D3, так как в строке 3 она является последней заполненнной. Заранее спасибо откликнувшимся.
Не получается сцепить в ячейке значения Inoutbox и ВПР
Пользователь
Сообщений: Регистрация: 18.01.2013
28.02.2014 20:15:58
По двойному клику пользователя в заданном диапазоне планируется вставка в активную ячейку конструкции типа 12*36,32 где 12 это количество, а 36,32 соответственно цена. Конструкция должна быть именно такая, так как в таком виде она в дальнейшем попадает на лист расчетов локальной сметы. Если я записываю через макрорекодер
то опять же все работает, но когда я добавляю 3-им элементом Application.VLookup(INDIRECT(Address(1, Column())), Range("A1:C2", 3) VBA при проверке выдает ошибку Complie error. Sub or Function not defined, выделяя при этом Column. Я так понимаю ему эта функция Column непонятна, так как созданная мной для пробы функция ВПР в которой четко указано искомое значение работает. Во вокруг этих 2 вариантов я и брожу 2 день. Запасной вариант есть, но хотелось бы знать, реален ли этот. Заранее спасибо всем откликнувшимся
). Я попытался исключить этап работы этого макроса и сэкономить время 
. На листе "Тест" по нажатию кнопки срабатывает макрос: 
) Ситуация такая: на форме имеется listbox на 13 столбцов (Data.ColumnCount = 13), сейчас для краткости кода они заполнены тестовыми значениями. Но заполняются только столбцы с 0 по 10, почему, ведь и количество столбцов указано и их ширина, а значений нет. Если снять комментарий со строки 