Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Neurosurgeon
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Ответить на диалоговое окно при сохранении книги Excel., Можно ли ответить Да или Нет на системное сообщение при сохранение книги Excel?
 
#
13.09.2023 16:04:37
Здравствуйте, уважаемые эксперты.
При сохранении или при закрытии книги Excel часто возникают различные сообщения, типа: "Книга содержит персональные данные ...". Могут быть и другие сообщения.
Обычно в таких случаях рекомендуют использовать Application.DisplayAlerts = False перед сохранением и Application.DisplayAlerts = True после.
А можно ли обработать данное событие, не отключая предупреждения? Можно ли, просто, ответить "Да" или "Нет"?
 
Перейти    
vba автофильтр, Как с помощью VBA в автофильтре "поставить несколько галочек" (выбрать несколько позиций)?
 
#
12.09.2023 16:40:12
Здравствуйте. Помогите, пожалуйста, решить проблему.
Есть диапазон Range(Cells(1,1),Cells(10,10))  на листе Excel (обычный диапазон) с заголовками. В столбце Cells(1,1) перечень продуктов: Молоко, Кефир, Колбаса. Нужно с помощью автофильтра отобразить только Молоко и Колбасу. Важно, чтобы Молоко и Колбаса задавались переменными.
Чего-то не получается совсем.
Заранее большое спасибо за помощь.
Код
Dim a as String, b as String
Dim arrArray() as Variant

a = "Молоко"
b = "Колбаса"
Redim arrArray(0 to 1)
arrArray(0) = a
arrArray(1) = b

Range(Cells(1,1),Cells(10,10).AutoFilter Field:=1, Criteria1:= arrArray
'При этом отображается только 1 элемент массива - Молоко, а колбаса не отображается. Возможно, я какой-то параметр не указываю.
 
Перейти    
VBA. Аналог формулы ВПР(Excel) для работы с большими массивами., Способы реализации сопоставления данных в 2-х массивах с большим количеством "строк" (данных в 1-ой размерности).
 
#
20.08.2023 12:04:11
Здравствуйте, уважаемые специалисты. Решение данной проблемы, скорей всего, не должно проводиться с использованием VBA - вероятно, лучше Python или другие языки. Но я, хоть как-то, могу работать только с VBA. Я попытаюсь объяснить суть проблемы. Если кто-нибудь сможет подсказать, в каком направлении думать, буду очень благодарен. Моих знаний, к сожалению, не хватает.
Убедительно прошу сильно не ругаться. Объясняю, как могу. Буду благодарен за любые идеи.

Задача. Есть 2 двумерных массива по 2 млн. "строк" и 4 "столбца". В массиве 1 содержатся клиенты, для которых нужно найти план, содержащийся в массиве 2. Модель в приложенном файле.
Каждый клиент уникален и повторяется к каждом массиве только 1 раз.
Таким образом, чтобы подтянуть план из 2-ого массива в 1-ый в Excel можно было бы использовать, например, ВПР. Реализация подобного в VBA возможна с помощью циклов "For i". Но программа работает очень долго, так как очень большое кол-во данных. Также можно усложнить и реализовать перебор массивов через For each, но, всё-равно, долго.
Единственный выход, который я вижу, это искать совпадения не во всём массиве 2, а в кусочке данных, относящихся к конкретному субрегиону. Вот, как это реализовать?
Я пытался вкладывать словари в словари по типу (это бы решило проблему):

dicSubregion.Add Key:= "Название уникального субрегиона", Item:= dicClientsOfTheSubregion(Клиенты, относящиеся к данному субрегиону)
dicClientsOfTheSubregion.Add Key:= "Название уникального клиента", Item:= "Номер строки в массиве"

К сожалению, вложенный словарь dicClientsOfTheSubregion содержит не только клиентов, относящиеся к конкретному субрегиону, а содержит вообще всех клиентов.
Основное препятствие реализации данного метода отражено в коде ниже.
Код
dicDicReg.Item("Проверка") = "Результат положительный" 'Заполняем словарь для вкладывания.
Set dicDic.Item("Словарь") = dicDicReg 'Вкладываем словарь с новым ключом.

'К сожалению, если очистить словарь dicDicReg, то он очистится и, будучи вложенным, в словаре dicDic.
dicDicReg.RemoveAll
'Выдаст ошибку.
a = dicDic.Item("Словарь").Item("Проверка")
'Можно ли как-то сделать так, чтобы словарь dicDicReg, будучи вложенным в dicDic, не менялся??? Это бы решило мою проблему.
 
Перейти    
VBA. Новая строка в теле письма Outlook, взятом из ячейки Excel., Как добиться новой строки в теле письма Outlook, взятом из ячейки Excel.
 
#
21.07.2023 08:19:32
Здравствуйте. Помогите, пожалуйста. Я, вероятно, не учитываю какой-то нюанс.
Есть VBA код в Excel (early binding), рассылающий письма по разным адресам. Адреса, темы, тела писем берутся из таблицы Excel.
В ячейку Excel, в которую пишется тело письма, я записываю текст. Новые строки в данном тексте я делаю с помощью Ctrl+Enter (это очень удобно).
К сожалению, мне не удаётся сделать так, чтобы новые строки в ячейке Excel становились новыми строками в теле письма OutLook.
Ниже мой вариант кода.
Код
'Получаем переформатированное тело письма из массива arrLetterSpecific, так чтобы воспринимались новые строки.
'strMailBody - это переменная в которую попадает значение ячейки типа String, содержащей текст тела письма.

 strMailBody = arrLetterSpecific(dicRegRowNum.Item(varKeyInDicRegionsList), intStartColNum + 5) 'Теперь в переменной текст тела письма.
 strMailBody = Replace(strMailBody, Chr(13), " <br> ") 'Меняем символ "возврат каретки" на " <br> ".
 strMailBody = strApealing & " <br> " & strMailBody 'Соединяем обращение и тело письма.

'Г. Создаём письма.
 Set olEmail = olApp.CreateItem(olMailItem)
 With olEmail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "<HTML><BODY><p align=;left >" & strMailBody & "</p></BODY></HTML>" & .HTMLBody & " <br> "
    .To = strMainAddresses
    .CC = strExtraAddresses
    .BCC = ""
    .Subject = strSubject
    .Attachments.Add strRegFullName                  
End With
 
Перейти    
Обфускация vba кода, Посоветуйте, пожалуйста, решение для обфускации кода vba.
 
#
15.07.2023 21:54:14
Здравствуйте. Нужно защитить проект vba от копирования. Пароли поставлю, модули скрою. Есть ли какое-либо решение для обфускации кода?
 
Перейти    
Получение номеров строк из несвязанного диапазона., Через Application.InputBox получаем несвязанный диапазон Rage. Нужно получить номера всех строк.
 
#
10.07.2023 15:34:35
Здравствуйте, уважаемые специалисты. Сразу извините, если не понимаю базовых вещей. Задача такая.
Пользователь получает окно Application.InputBox, выбирает мышкой несвязанный диапазон ячеек.
Нужно определить номера всех строк в это диапазоне.
Для связанного диапазона, вроде, всё просто, а как быть с не связанным ($A$2; $A$4:$A$5)?
Код
'Определение номеров строк связанного диапазона.
Dim rngRange As Range
Dim lngStartRowNum As Long, lngLastRowNum As Long

Set rngRange = Application.InputBox(prompt:="Выделите диапазон обработки.", Type:=8)
lngStartRowNum = rngRange.Row
lngLastRowNum = lngStartRowNum + rngRange.Rows.Count - 1
 
Перейти    
Не определяется "FileFormat:=xlOpenXMLWorkbook" при сохранении книги., По какой-то причине Exel выдаёт ошибку при попытке сохранить книгу без макросов.
 
#
03.07.2023 10:16:50
Здравствуйте. Помогите, пожалуйста, разобраться. Самостоятельно найти решение никак не получается.
VBA код находится в книге 1. Код запускает обработку Книги2 (.xlsm), которая содержит макросы. В конце код книги1 должен сохранить Книгу2 под новым именем и без макросов.
Код
strWbName = strDirForReg & "\" & strWbName & "_" & varKeyInDic & ".xlsx"
wbBookForPreparing.SaveCopyAs Filename:=strWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Программа выдаёт ошибку, ссылаясь на FileFormat. Я не могу понять, почему. Раньше такая строка кода работала в других программах.
Ошибка: "Compile Error: Named argument not found."
Заранее большое спасибо за помощь.
 
Перейти    
Функция определения координат значения String в двумерном Array., В двумерный массив занесена таблица Excel c заголовками. Нужно сделать функцию поиска координат любого заголовка по значению String.
 
#
03.05.2023 23:58:12
Здравствуйте. Помогите, пожалуйста.
Есть двумерный массив, содержащий таблицу Excel c заголовками. Нужно создать функцию, которая будет перебирать массив и выдавать позиции искомого заголовка (String) в 1-ом и 2-ом измерении. Как сделать это без функции, я понимаю. Проблема с функцией для меня в том, что я не могу добиться, чтобы функция выдавала 2 значения одновременно.
Ниже представлено решение, которое я разрабатываю. Возможно, Вы можете предложить более разумное решение. Заранее огромное спасибо.
Код
'Модуль, из которого вызывается функция.
Dim colWordAddress As New Collection
Dim arrForFunc() As Variant, strNameToFindInFunc As String 'Переменные для функции

    strNameToFindInFunc = "Субрегион" 'Значение String, координаты которого должна найти функция.
    arrForFunc = arrSheetDatas
    colWordAddress = fNameDetectionInArray(arrForFunc, strNameToFindInFunc) 'Вот здесь возникает ошибка. Не знаю почему.

' _____________________________________________________________
'Сама функция.
Function fNameDetectionInArray(arrForFunc As Variant, strNameToFindInFunc As String) As Collection
'Данная функция возвращает координаты 2-размерного массива, где содержится значение strNameToFindInFunc.
'Обязательно нужно передать в функцию массив "arrForFunc" и искомый текст "strNameToFindInFunc".

Dim lngArrayRowIndex As Long, lngArrayColIndex As Long
Dim strNameWasFound As String

    Set fNameDetectionInArray = New Collection
     'А. Перебираем массив для поиска значения strNameToFindInFunc.
       
        For lngArrayRowIndex = LBound(arrForFunc, 1) To LBound(arrForFunc, 1) + 10 Step 1
            For lngArrayColIndex = LBound(arrForFunc, 2) To UBound(arrForFunc, 2) Step 1
                strNameWasFound = arrForFunc(lngArrayRowIndex, lngArrayColIndex) 'Найденное значение, записанное в массиве.
                If UCase(strNameWasFound) Like UCase(strNameToFindInFunc) Then
                    fNameDetectionInArray.Add lngArrayRowIndex
                    fNameDetectionInArray.Add lngArrayColIndex
                    Exit For
                End If
            Next lngArrayColIndex
            If fNameDetectionInArray(1) <> 0 Then
                Exit For
            End If
        Next lngArrayRowIndex
End Function
 
Перейти    
Application.Volatile включён по умолчанию?, UDF (пользовательская функция) почему-то запускается при изменении любых ячеек на листе, а не только связанных.
 
#
17.04.2023 00:06:37
Здравствуйте. Буду признателен за помощь. Сам разобраться никак не могу. Укажу данные, которые, возможно, имеют значение.
Создал UDF вида "Funkciya($A1;$G8)". Тип данных Variant.
Ячейки "А1" и "G8" не зависят от ячейки с UDF.
"Application.Volatile=True" НЕТ в коде.
Функция вставлена в ячейку обычного диапазона (не Data table).
Другие ячейки строки в своих формулах ссылаются на ячейку с UDF.
На листе множество ячеек с условным форматированием.
По какой-то причине UDF запускается при изменении любой ячейки листа, а не только "А1" и "G8". А запустившись, выполняется 4 раза.
Как такое может быть? Заранее большое спасибо за помощь.
 
Перейти    
Передача переменных из UserForm в процедуру обычного модуля., Нужно передать переменную из процедуры кнопки UserForm в процедуру обычного модуля для дальнейшего использования этой переменной.
 
#
29.07.2022 12:21:33
Господа, здравствуйте. Я в тупике. По задумке пользователь вводит в UserForm данные, которые потом должны использоваться в различных процедурах обычных модулей. Очевидно, что для этого нужно передать переменные из UserForm в обычный модуль.
В частности, нужно при нажатии кнопки "Отмена" присвоить переменной pubIfExitSub значение True. И эту переменную передать в обычный модуль и в нём уже обработать. К сожалению, не получается, даже если сделать её глобальной.
Это только пример. Моя UserForm планируется быть значительно сложней. Обрабатывать данные внутри UserForm вообще не вариант.
Спасибо.

Модуль. Процедура 1.
Код
Public pubIfExitSub as Boolean

Sub Test ()
Dim uf1UserSettings As UserForm1

Set uf1UserSettings = VBA.UserForms.Add(UserForm1.Name)
uf1UserSettings.Show vbModal

End Sub

UserForm. При нажатии на кнопку "Отмена" переменной должно присвоиться значение True.

Код
Private Sub CommandButton_Cancel_Click()
    
    pubIfExitSub = True 'При нажатии кнопки "Отменить выполнение программы", данная глобальная переменная становится True, и в 
                         основной процедуре она проверяется и прекращается выполнение программы.

End sub

Модуль. Процедура 2.

Код
Sub Processing_pubIfExitSub ()
        Select Case pubIfExitSub1 'Если в пользовательской форме нажата кнопка "Отменить выполнение программы", нужно выйти из процедуры.
            Case pubIfExitSub1 = True
                Exit Sub
        End Select

End sub
 
Перейти    
Не работает ReDim Preserve., По какой-то причине не работает ReDim Preserve для массива.
 
#
21.07.2022 16:55:23
Здравствуйте. Задача удалить из массива ненужные строки, которые помечены в столбце "-1000". Для этого создаётся другой динамический массив  arrayBrendFinal. Строки старого массива перебираются циклом. Если пометка "-1000" не определяется, то переопределяется размерность нового массива и в него вставляется строка из старого массива. Каждая последующая уникальная строка (без "-1000") из старого массива вставляется в новый массив ниже предыдущей уникальной. Почему-то новый массив не хочет 2-ой раз переопределять размерность с сохранением данных.
Заранее большое спасибо, если подскажите, что я не учёл или где ошибся.
Код
'B. Заносим уникальные аптеки в новый массив без заголовков. Заносим только уникальные аптеки. Повторяющиеся не заносим.

Sub DaletingSpareRows(ByVal arrayBrend As Variant, ByVal ColNumbIdPharmacyInArrayOrigin As Integer)

    Dim ByRef arrayBrendFinal as Variant
    Dim RowNum As Long, RowNum1 As Long, RowNumInsertToCurent As Long, RowNumInsertToPrevious As Long
    Dim ColNum As Integer
    Dim lngIdPharmacy As Long, lngIdPharmacy1 As Long
    Dim lngIDCurent As Long
    Dim lngEndRowForArrBrendFinal As Long
    Dim n As Long
    Dim lngStartRow As Long, lngEndRow As Long, intStartCol As Integer, intEndCol As Integer
        
        lngStartRow = LBound(arrayBrend, 1) + 1 '+1 это чтобы без заголовков.
        lngEndRow = lngStartRow
        intStartCol = LBound(arrayBrend, 2)
        intEndCol = UBound(arrayBrend, 2)
        
                    n = 0
        For RowNum = LBound(arrayBrend, 1) + 1 To UBound(arrayBrend, 1) ' Перебираем строки старого массива
            
            lngIdPharmacy = arrayBrend(RowNum, ColNumbIdPharmacyInArrayOrigin)
            Select Case lngIdPharmacy
                Case Is <> -1000 'Так помечены повторяющиеся аптеки в столбце ID.
                    'Переопределяем размер нового массива. Размер равен 1 строке.
                    lngEndRowForArrBrendFinal = lngStartRow + n
 

                   

Вот здесь возникает ошибка. Изначально динамический массив пустой. В первую итерацию цикла данный массив переопределяется = 1 строке. 
А вот при попытке увеличить его ещё в следующую итерацию, возникает ошибка.

ReDim Preserve arrayBrendFinal(lngStartRow To lngEndRowForArrBrendFinal, intStartCol To intEndCol)



                    
                        For ColNum = LBound(arrayBrend, 2) To UBound(arrayBrend, 2) Step 1 'Копируем строку из старого массива в новый.
                            arrayBrendFinal(lngEndRowForArrBrendFinal, ColNum) = arrayBrend(RowNum, ColNum)
                        Next ColNum
                    n = n + 1
            End Select
            
        Next RowNum
 
Перейти    
Сослаться на диапазон внутри VBA array., Для использования функций min и max хочу сослаться на диапазон внутри array.
 
#
03.07.2022 22:34:34
Здравствуйте. Есть array (1 to 100, 1 to 100). В него внесены числовые данные  range(A1:Z100). Нужно найти максимальное числовое значение в диапазоне array (10,5):(15,20). Записал по аналогии с range. Не знаю правильный синтаксис для array, чтобы сослаться не на весь массив, а только на диапазон внутри массива.
Заранее спасибо.
 
Перейти    
Вставка с помощью VBA символа " ≥ " в ячейку в текстовом виде., Вставка с помощью VBA символа " ≥ " в ячейку в текстовом виде.
 
#
10.06.2022 13:53:57
Здравствуйте. Подскажите, пожалуйста, как вставить символ " ≥ " в ячейку Excel в текстовом виде. VBA категорически отказывается понимать мой код.
Код
Sub Case1 ()
cells(1,1).value = "Число " & Chr(63) & "трём"
End Sub
'Присвоить ячейке значение типа String: "Число ≥ трём"
 
Перейти    
Array. LBound, UBound., Процедура выдаёт ошибку в цикле For i c использованием LBound и UBound.
 
#
26.04.2022 13:42:54
Господа, здравствуйте. Не могу понять, что не так. По идее, программа должна работать, но не работает. В книге много листов, но для обработки нужно взять только  некоторые конкретные, чётко определённые изначально листы. Их я и хочу объединить в массив.
Естественно, вместо MsgBox будет другой код.
Ошибка возникает в строке "For i ..."
Да, я знаю, что можно всё сделать через "For each", но хотелось бы, всё-таки, разобраться, почему данный код не работает.
Заранее большое спасибо за помощь.
Код
Sub ForExample ()
Dim arrDestinationSheets As Variant
Dim i as Long

Set arrDestinationSheets = ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6"))
For i = LBound(arrDestinationSheets) To UBound(arrDestinationSheets) Step 1
   MsgBox (arrDestinationSheets(i).Name)
Next i


End sub
Изменено: Neurosurgeon - 26.04.2022 13:43:19
 
Перейти    
Метод Select из класса Worksheet завершён неверно.
 
#
16.01.2022 20:34:38
Здравствуйте, уважаемые специалисты. Я столкнулся с проблемой, которая, вероятно, покажется вам глупой, но, тем не менее, я исчерпал все свои собственные возможности для её решения. Возможно, вы сможете или указать на ошибку, или, хотя бы, направить в нужную сторону для поиска решения. За любую помощь заранее благодарен.
Итак, процедура делает следующее:
  1. Пользователь выбирает книги Excel (GetOpenFilename) для обработки.
  2. Данные в книгах обрабатываются и переносятся в другую книгу, тоже выбранную с помощью GetOpenFilename.
  3. Проблема в том, что в начале процедуры код "WbToInsert.Worksheets("IQVIA").Select" выполняется корректно, а в конце той же самой процедуры тот же код выдаёт ошибку: "Метод Select из класса Worksheet завершён неверно".
  4. WbToInsert - объектная переменная, действующая во всём модуле (Private, объявлена в шапке модуля и назначена в одной из процедур модуля).
  5. Книга не закрывалась, листы не удалялись и не переименовывались. Листы имеют свойство "visible".
  6. Ниже я приведу код процедуры, как есть.
Код
Sub InsertDatasSubreg()
'6. Вставляем данные из исходных книг в книгу "KPI..." по субрегионам.

Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z As Long
Dim lngLastRowNumberKPI As Long
Dim lngStartRowNumberKPI As Long
Dim lngCurentRowNumberKPI As Long
Dim objBasicCellKPI As Range
Dim strCellNameKPI As String
Dim lngCurentBookNumberOrigin As Long
Dim strWb As String
Dim Wb As Workbook
Dim Wsh As Worksheet
Dim strWshName As String
Dim strWshNameApprox As String
Dim strCellNameSubregOrigin As String
Dim strCellNameBrandOrigin As String
Dim lngLastRowNumber As Long
Dim lngStartRowNumber As Long
Dim lngCurentRowNumberOrigin As Long
Dim objBasicCell As Range



WbToInsert.Worksheets("IQVIA").Select 'Выбираем лист в книге "KPI", куда будут вставляться данные - Работает корректно, а в самом конце процедуры то же самое, выдаёт ошибку

lngLastRowNumberKPI = Cells(Rows.Count, 2).End(xlUp).Row 'Определяем номер последней строки 2-ого столбца.
    For a = 1 To lngLastRowNumberKPI Step 1 'Определяем номер первой строки начала диапазона - сразу под Субрегион.
        Set objBasicCellKPI = ActiveSheet.Cells(a, 2)
            Select Case objBasicCellKPI
                Case Is = "IQVIA"
                    b = a
                    Exit For
            End Select
    Next a
lngStartRowNumberKPI = b + 1 'Это № строки начала диапазона.

'Очищаем содержимое диапазона ранее вставленных данных
Range("C" & lngStartRowNumberKPI & ":" & "AZ" & lngLastRowNumberKPI).Select
Selection.ClearContents

    For lngCurentRowNumberKPI = lngStartRowNumberKPI To lngLastRowNumberKPI Step 1 'Перебираем каждую строку листа "IQVIA", диапазона для вставки.
        strCellNameKPI = WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 2).Value 'Содержимое ячейки
'        Debug.Print "lngCurentRowNumberKPI= " & lngCurentRowNumberKPI
'        Debug.Print "strCellNameKPI= " & strCellNameKPI
        
        For lngCurentBookNumberOrigin = LBound(varFilesToOpen) To UBound(varFilesToOpen) Step 1
            strWb = Dir(varFilesToOpen(lngCurentBookNumberOrigin))
            Set Wb = Workbooks(strWb) 'Назначаем объектную переменную, ссылающуюся на исходную книгу с данными по субрегионам.
            Wb.Activate
                
            For Each Wsh In Wb.Worksheets 'Перебираем каждый лист исходной книги по субрегионам.
                Wsh.Activate
                strWshName = Wsh.Name 'Имя текущего листа
                strWshNameApprox = UCase("*" & strWshName & "*") 'Приблизительное имя текущего листа
'             Debug.Print "strWshName= " & strWshName
                lngLastRowNumber = Cells(Rows.Count, 1).End(xlUp).Row 'Определяем номер последней строки первого столбца. Это № строки конца диапазона копирования исходной книги.
                    For d = 1 To lngLastRowNumber Step 1 'Определяем номер первой строки начала диапазона копирования - сразу под IQVIA.
                        Set objBasicCell = ActiveSheet.Cells(d, 1) 'Исходная книга
                            Select Case objBasicCell
                                Case Is = "Субрегион"
                                    e = d
                                    Exit For
                            End Select
                    Next d
                lngStartRowNumber = e + 1 'Это № строки начала диапазона копирования.
                    
                    For lngCurentRowNumberOrigin = lngStartRowNumber To lngLastRowNumber Step 1  'Перебираем каждую строку исходного листа.
                        strCellNameSubregOrigin = Cells(lngCurentRowNumberOrigin, 1).Value 'Имя ячейки столбца Субрегион.
                        strCellNameBrandOrigin = Cells(lngCurentRowNumberOrigin, 2).Value 'Имя ячейки столбца Торговые названия.
                            Select Case strCellNameSubregOrigin 'Проверяем содержимое ячеек исходных книг.
                                Case Is = strCellNameKPI 'Если имя ячейки исходной книги совпадает с именем ячейки KPI
    '                                      MsgBox ("Names are identical. ") & strCellNameKPI
                                    If strCellNameBrandOrigin Like strWshNameApprox Then 'Если в имени ячейки содержится имя листа
    '                                                MsgBox ("Names are identical. ") & strCellNameBrandOrigin
                                        Select Case strWshName 'Куда именно вставлять данные на лист IQVIA
                                            Case Is = "Арипризол"
                                                Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 3) 'Копируем прошлую долю рынка
                                                Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 4) 'Копируем настоящую долю рынка
                                            Case Is = "Сервитель"
                                                Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 7) 'Копируем прошлую долю рынка
                                                Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 8) 'Копируем настоящую долю рынка
                                            Case Is = "Каликста"
                                                Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 11) 'Копируем прошлую долю рынка
                                                Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 12) 'Копируем настоящую долю рынка
                                            Case Is = "Катэна"
                                                Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 15) 'Копируем прошлую долю рынка
                                                Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 16) 'Копируем настоящую долю рынка
                                            Case Is = "Вертран"
                                                Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 19) 'Копируем прошлую долю рынка
                                                Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 20) 'Копируем настоящую долю рынка
                                        End Select
                                        Else
                                    End If
    '
                                Case Is = "КЛАСТЕР" 'Если имя ячейки "КЛАСТЕР", то сравни имя ячейки выше "Кластер" с именем ячейки в "KPI"
                                    Select Case Cells(lngCurentRowNumberOrigin - 1, 1).Value
                                        Case Is = strCellNameKPI
                                            Select Case strWshName 'Куда именно вставлять данные на лист IQVIA
                                                Case Is = "Арипризол"
                                                    Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 5) 'Копируем объём рынка прошлого периода
                                                    Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 6) 'Копируем объём рынка настоящего периода
                                                Case Is = "Сервитель"
                                                    Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 9) 'Копируем объём рынка прошлого периода
                                                    Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 10) 'Копируем объём рынка настоящего периода
                                                Case Is = "Каликста"
                                                    Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 13) 'Копируем объём рынка прошлого периода
                                                    Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 14) 'Копируем объём рынка настоящего периода
                                                Case Is = "Катэна"
                                                    Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 17) 'Копируем объём рынка прошлого периода
                                                    Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 18) 'Копируем объём рынка настоящего периода
                                                Case Is = "Вертран"
                                                    Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 21) 'Копируем объём рынка прошлого периода
                                                    Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 22) 'Копируем объём рынка настоящего периода
                                            End Select
                                    End Select
                            End Select
                    Next lngCurentRowNumberOrigin
            Next Wsh
        Next lngCurentBookNumberOrigin
    Next lngCurentRowNumberKPI
    
WbToInsert.Worksheets("IQVIA").Select 'На данном этапе возникает ошибка: "Метод Select из класса Worksheet завершён неверно."

'Call InsertDatasReg
End Sub
 
Перейти    
GetOpenFilename. Как сослаться на элемент массива, Ссылка на объект массива.
 
#
23.11.2021 09:35:55
Здравствуйте. Сразу прошу прощения за глупые вопросы. Я не могу никак правильно сослаться на элемент массива. Пользователь выбирает из диалогового окна несколько книг для обработки. Для этой обработки данных нужно создать переменную для каждой выбранной книги массива (перебор с помощью For each недостаточно). А я даже не могу получить имя 1-ой книги в данном массиве. Заранее большое спасибо.
Код
Sub WhatFilesShouldBeOpened()
Dim varFilesToOpen As Variant
Dim varWb As Variant 
Dim varFirstWbInArray As Variant
Dim x As Variant
Dim strWshName as String

'Вызываем диалог выбора файлов для импорта. varFilesToOpen - переменная массива, в котором содержатся все выбранные книги.
varFilesToOpen = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="Выберите файлы")
If TypeName(varFilesToOpen) = "Boolean" Then
    MsgBox "Не выбрано ни одного файла!"
    Exit Sub
End If

For Each varWb In varFilesToOpen
    Workbooks.Open varWb
Next varWb

'Мне нужно получить имя книги №1 в массиве varFilesToOpen
x=varFilesToOpen(1)
strWshName=Workbooks(x).name
msgbox strWshName
End sub
 
Перейти    
Во всех листах всех открытых книг искать сводные таблицы
 
#
06.07.2021 16:50:21
Код
Sub dfdf()
Dim wb As Workbook
Dim sh As Worksheet

For Each wb In Application.Workbooks
wb.Activate
MsgBox ActiveWorkbook.Name
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
If ActiveSheet.PivotTables.Count > 0 Then
MsgBox "Есть сводная"

End If
Next sh
Next wb
End Sub
Господа, добрый день. Помогите, пожалуйста. Я уже всё перебрал. Надежда на вас. Почему-то не работает код с For Each. Перебирает листы, но не перебирает книги. Цель перебрать все листы в открытых книгах, найти там сводные таблицы и, если сводная есть, применить к ней код настройки (код настройки я не прописал).
Даже в этом виде код не работает.
 
Перейти    
Проверка наличия символов в имени книги
 
#
13.06.2021 17:02:56
Здравствуйте. Мой вопрос очень примитивный, но я в тупике. Есть потребность привязать выполнение процедуры к имени книги. Имя может меняться. Неизменной всегда остаётся только одно слово "Отчёт". Варианты имён: "Отчёт", "аываОтчёт", "ававОтчёт_ыавыа", ...
Мой код почему-то не работает. Основной код я заменил на msgbox.

Код
dim wbn as string
wbn = ActiveWorkbook.Name
Select Case wbn
Case wbn = "*Отчёт*"
MsgBox "Это отчёт"
Case wbn <> "*Отчёт*"
MsgBox "Это НЕ отчёт"
End Select

Заранее спасибо.
Изменено: vikttur - 13.06.2021 17:24:18
 
Перейти    
Создание сообщения Lync c с помощью VBA
 
#
20.09.2018 12:28:36
Здравствуйте.
Нужно из Excel, с помощью VBA, создать сообщение в Lync конкретному контакту (contact@pochta.ru). В данное сообщение нужно вложить файл названия "X". И отправить.
К сожалению, нельзя использовать Outlook, только Lync.
Пожалуйста, помогите. Очень мало информации в интернете по данному вопросу.
Заранее большое спасибо.
 
Перейти    
VBA: сослаться на активную сводную таблицу на активном листе
 
#
27.04.2018 16:30:08
Здравствуйте. Задача написать код, для фильтрации сводной таблицы. Например:
Код
Sub Filtеr()
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Регион")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Субрегион")
.Orientation = xlRowField
.Position = 2
End With
End Sub

В данном виде, с данной конкретной таблицей он работает. Но, если сводная таблица имеет другое имя, то код не работает. Как сослаться на активную сводную таблицу на активном листе? На листе только одна сводная таблица.
Сразу оговорюсь, естественно, такую примитивную фильтрацию сводной таблицы я взял только для примера.
 
Перейти    
VBA. Диалоговые окна. Кнопки с произвольными названиями.
 
#
08.07.2016 23:32:27
Здравствуйте. Пожалуйста, помогите сделать в VBA, в msgbox кнопки с произвольными названиями.
Например, "Заблокировать", "Разблокировать".
Заранее большое спасибо.
 
Перейти    
Стандартная подпись в письмо outlook из VBA Excel, Добавить кодом стандартную подпись в письмо из Excel
 
#
15.05.2016 22:57:50
Здравствуйте. При рассылке через outlool из VBA Excel нужно вставить в конце письма стандартную подпись, которая заранее создана в Outlook.
Пожалуйста, подскажите, как это можно сделать. Заранее большое спасибо.
Код
...
Dim objMailFE As Object
Dim WbLetterSpecific As Object
Set objMailFE = objOutlookApp.CreateItem(0)
Set WbLetterSpecific = Workbooks("Letter_Specific.xlsx").Worksheets("Письмо")
    With objMailFE
        .To = WbLetterSpecific.Range("B2").Value
        .CC = WbLetterSpecific.Range("C2").Value
        .BCC = "" 
        .Subject = WbLetterSpecific.Range("D2").Value
        .Body = WbLetterSpecific.Range("E2").Value & vbCr & WbLetterSpecific.Range("F2").Value
        .Attachments.Add PathFE  
        .Display 
    End With
 
Перейти    
Удаление диапазонов строк, определённых переменными, Как удалить несвязанный диапазон строк в эксель, где номера строк определены переменными.
 
#
06.05.2016 22:10:53
Здравствуйте, проблема такая.
Есть переменные, определяемые другой процедурой. Эти переменные определяют первые и последние строки диапазонов.
Нужно удалить строки диапазонов.

start1 - переменная, номер первой строки первого диапазона
finish1 - переменная, номер последней строки первого диапазона
start2 - переменная, номер первой строки второго диапазона
finish2 - переменная, номер последней строки второго диапазона

Дальше нужно удалить эти строки, сделать что-то типа:
Код
Range ("start1:finish1, start2:finish2").delete
 
Перейти    
Перебор объектов с помощью цикла, Как применить одинаковую инструкцию к перечню книг excel.
 
#
03.05.2016 21:46:30
Здравствуйте. Такая проблема.
Есть 10 книг excel с известными названиями, расположенных в известных папках (пути известны).
Для каждой книги объявлена объектная переменная. Например: Wb1, Wb2, ..., Wb9, Wb10.
С каждой книгой нужно проделать одинаковую процедуру, связанную с названием книги.
Например:
Код
Wb1.WorkSheets(1).Activate
Range("A1").Value = wb1.Name
Можно ли как-нибудь перебрать эти книги циклом? Не все книги. Не все открытые книги, а только эти.
 
Перейти    
Сохранение копии книги (xlsx), Книгу .xlsm копировать как .xlsx (без поддержки макросов)
 
#
24.04.2016 23:17:03
Здравствуйте. Проблема такая. Есть книга .xlsm. В ней есть код VBA. Нужно сделать копию этой книги, но уже без поддержки макросов, то есть, имя_копии.xlsx
Делаю так:
Код
ActiveWorkbook.SaveCopyAs DirForRegFE & "\" & WbName1 & "_FE.xlsx"
Копия с расширением .xlsx создаётся, но при попытке открыть выскакивает сообщение: "Не удаётся открыть файл "имя файла", так как формат или расширение этого файла являются недопустимыми. Убедитесь, что файл не повреждён и расширение его имени соответствует его формату."
 
Перейти    
Всё содержимое листа преобразовать в значения, убрав формулы
 
#
24.04.2016 19:20:54
Есть задача удалить все формулы с листа, заменив их значениями ("Вставить как значение"). Ничего лучше чем пример ниже в голову не приходит. Может можно, как-то проще и оптимальней? Очень не хочется "Select" использовать.
Код
Worksheets(1).Activate
Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
 
Перейти    
Защитить лист с помощью VBA, Защита паролем листа VBA
 
#
26.03.2016 17:29:35
Здравствуйте. Столкнулся с проблемой.
Хочу защитить лист и поставить пароль на снятие защиты с листа.
Как защитить знаю (код ниже). Но как поставить пароль, например, 111?
Код
Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    Sheets("Inf").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Перейти    
С помощью VBA определить, открыта ли книга
 
#
13.03.2016 14:39:58
Здравствуйте, буду очень признателен за помощь.
Нужно определить открыта ли уже "Книга1", находящаяся в той же директории, что и книга, из которой запускается код VBA. Почему-то выдаётся ошибка "Sub or Function not defind". При этом выделяется "IsWorkBookOpen".
Я максимально упростил пример. Мне важно понять принцип.
Код
Sub IfBOp()
ThisWorkBookPath = ThisWorkbook.Path
x = IsWorkBookOpen(ThisWorkBookPath & "\Книга1.xlsx")
Select Case x
    Case True: MsgBox "Книга открыта", vbInformation, "Сообщение"
    Case False: MsgBox "Книга закрыта", vbInformation, "Сообщение"
End select
End Sub
Изменено: Neurosurgeon - 13.03.2016 17:36:01
 
Перейти    
Цикл "For Next" для несвязанного диапазона, исключить из обработки циклом, например, 3,21,47,60,90 строки
 
#
29.02.2016 23:11:31
Здравствуйте, наверняка, вопрос покажется примитивным.
Есть 2 одинаковых несвязанных диапазона (1 столбец) на разных листах книги. Нужно сумму соответствующих ячеек (А1 + А1; В1+В1; ...) этих диапазонов вставить в 3-ий точно такой же несвязанный диапазон на 3-ем листе (консолидировать данные).
Для связанного диапазона проблем нет. Использую цикл "For Next". Но как исключить из обработки определённые ячейки (=строки)? При этом, естественно, не хочется делать много циклов "For Next".
Заранее большое спасибо.
Изменено: Neurosurgeon - 29.02.2016 23:31:53
 
Перейти    
Страницы: 1
Наверх