vadik-ceo (Автор тем)

Прекращение работы Excel при выполнении макроса (закрывается текущая книга и открывается пустая)

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

05.07.2018 12:41:12

Ребят, добрый день.
Выполняю макрос -> прекращается работа в экселе -> открывается новая пустая книга. Подскажите почему и как исправить, пожалуйста.

Код

Sub BG_pol()
    Dim iBeginRange As Object, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean
     
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 
    name_conso = ThisWorkbook.Name
     
    Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(5).ClearContents
    Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(6).Resize(1000).Delete
         
    Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(8).Resize(1000).Delete
     
    Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(8).Resize(1000).Delete
     
    Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(8).ClearContents
    Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(9).Resize(1000).Delete
     
    Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(8).Resize(1000).Delete
     
    Workbooks(name_conso).Sheets("Аккредитивы").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Аккредитивы").Rows(8).Resize(1000).Delete
 
    sSheetName = "БГ_получ_(в_пользу_группы)"
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes)
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
     
     
    'Копирование нужных значений
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
            Bookopenname = ActiveWorkbook.Name
        Else
            Set wbAct = ThisWorkbook
        End If
         
        lLastrowBG_pol1 = Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Range(Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(5, 2), Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(lLastrowBG_pol1, 20)).Copy
        lLastrowBG_pol2 = Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(lLastrowBG_pol2, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(5).Copy
        lLastrowBG_pol3 = Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(6).Resize(lLastrowBG_pol3).PasteSpecial Paste:=xlPasteFormats
         
        lLastrowBG_pol4 = Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Range(Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(7, 2), Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(lLastrowBG_pol4, 21)).Copy
        lLastrowBG_pol5 = Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(lLastrowBG_pol5, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(7).Copy
        lLastrowBG_pol6 = Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(8).Resize(lLastrowBG_pol6).PasteSpecial Paste:=xlPasteFormats
         
        lLastrowBG_pol7 = Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Поручительства_выданные").Range(Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(7, 2), Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(lLastrowBG_pol7, 23)).Copy
        lLastrowBG_pol8 = Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(lLastrowBG_pol8, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(7).Copy
        lLastrowBG_pol9 = Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(8).Resize(lLastrowBG_pol9).PasteSpecial Paste:=xlPasteFormats
 
        lLastrowBG_pol10 = Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Поручительства_полученные").Range(Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(8, 2), Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(lLastrowBG_pol10, 23)).Copy
        lLastrowBG_pol11 = Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(lLastrowBG_pol11, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(8).Copy
        lLastrowBG_pol12 = Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(9).Resize(lLastrowBG_pol12).PasteSpecial Paste:=xlPasteFormats
         
        lLastrowBG_pol13 = Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Прочие_обязательства").Range(Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(7, 2), Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(lLastrowBG_pol13, 22)).Copy
        lLastrowBG_pol14 = Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(lLastrowBG_pol14, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(7).Copy
        lLastrowBG_pol15 = Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(8).Resize(lLastrowBG_pol15).PasteSpecial Paste:=xlPasteFormats
         
        lLastrowBG_pol13 = Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Аккредитивы").Range(Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(7, 2), Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(lLastrowBG_pol13, 22)).Copy
        lLastrowBG_pol14 = Workbooks(name_conso).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Аккредитивы").Cells(lLastrowBG_pol14, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Аккредитивы").Rows(7).Copy
        lLastrowBG_pol15 = Workbooks(name_conso).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Аккредитивы").Rows(8).Resize(lLastrowBG_pol15).PasteSpecial Paste:=xlPasteFormats
 
        If bPolyBooks Then wbAct.Close False
    Next li
     
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
 
End Sub

Перейти

[ Закрыто] Ошибка при выполнении макроса, Прекращение работы Excel при выполнении макроса

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

05.07.2018 12:34:40

Ребят, добрый день.
Выполняю макрос -> прекращается работа в экселе -> открывается новая пустая книга. Подскажите почему и как исправить, пожалуйста.
Код ниже:

Код

Sub BG_pol()
    Dim iBeginRange As Object, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

    name_conso = ThisWorkbook.Name
    
    Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(5).ClearContents
    Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(6).Resize(1000).Delete
        
    Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(8).Resize(1000).Delete
    
    Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(8).Resize(1000).Delete
    
    Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(8).ClearContents
    Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(9).Resize(1000).Delete
    
    Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(8).Resize(1000).Delete
    
    Workbooks(name_conso).Sheets("Аккредитивы").Rows(7).ClearContents
    Workbooks(name_conso).Sheets("Аккредитивы").Rows(8).Resize(1000).Delete

    sSheetName = "БГ_получ_(в_пользу_группы)"
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes)
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    
    
    'Копирование нужных значений
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
            Bookopenname = ActiveWorkbook.Name
        Else
            Set wbAct = ThisWorkbook
        End If
        
        lLastrowBG_pol1 = Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Range(Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(5, 2), Workbooks(Bookopenname).Sheets("БГ_получ_(в_пользу_группы)").Cells(lLastrowBG_pol1, 20)).Copy
        lLastrowBG_pol2 = Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(lLastrowBG_pol2, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(5).Copy
        lLastrowBG_pol3 = Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_получ_(в_пользу_группы)").Rows(6).Resize(lLastrowBG_pol3).PasteSpecial Paste:=xlPasteFormats
        
        lLastrowBG_pol4 = Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Range(Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(7, 2), Workbooks(Bookopenname).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(lLastrowBG_pol4, 21)).Copy
        lLastrowBG_pol5 = Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(lLastrowBG_pol5, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(7).Copy
        lLastrowBG_pol6 = Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("БГ_выдан_(в_пользу_3их_лиц)").Rows(8).Resize(lLastrowBG_pol6).PasteSpecial Paste:=xlPasteFormats
        
        lLastrowBG_pol7 = Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Поручительства_выданные").Range(Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(7, 2), Workbooks(Bookopenname).Sheets("Поручительства_выданные").Cells(lLastrowBG_pol7, 23)).Copy
        lLastrowBG_pol8 = Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(lLastrowBG_pol8, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(7).Copy
        lLastrowBG_pol9 = Workbooks(name_conso).Sheets("Поручительства_выданные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_выданные").Rows(8).Resize(lLastrowBG_pol9).PasteSpecial Paste:=xlPasteFormats

        lLastrowBG_pol10 = Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Поручительства_полученные").Range(Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(8, 2), Workbooks(Bookopenname).Sheets("Поручительства_полученные").Cells(lLastrowBG_pol10, 23)).Copy
        lLastrowBG_pol11 = Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(lLastrowBG_pol11, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(8).Copy
        lLastrowBG_pol12 = Workbooks(name_conso).Sheets("Поручительства_полученные").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Поручительства_полученные").Rows(9).Resize(lLastrowBG_pol12).PasteSpecial Paste:=xlPasteFormats
        
        lLastrowBG_pol13 = Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Прочие_обязательства").Range(Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(7, 2), Workbooks(Bookopenname).Sheets("Прочие_обязательства").Cells(lLastrowBG_pol13, 22)).Copy
        lLastrowBG_pol14 = Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(lLastrowBG_pol14, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(7).Copy
        lLastrowBG_pol15 = Workbooks(name_conso).Sheets("Прочие_обязательства").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Прочие_обязательства").Rows(8).Resize(lLastrowBG_pol15).PasteSpecial Paste:=xlPasteFormats
        
        lLastrowBG_pol13 = Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(Bookopenname).Sheets("Аккредитивы").Range(Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(7, 2), Workbooks(Bookopenname).Sheets("Аккредитивы").Cells(lLastrowBG_pol13, 22)).Copy
        lLastrowBG_pol14 = Workbooks(name_conso).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Аккредитивы").Cells(lLastrowBG_pol14, 2).PasteSpecial Paste:=xlPasteValues
        Workbooks(name_conso).Sheets("Аккредитивы").Rows(7).Copy
        lLastrowBG_pol15 = Workbooks(name_conso).Sheets("Аккредитивы").Cells(Rows.Count, 2).End(xlUp).Row + 1
        Workbooks(name_conso).Sheets("Аккредитивы").Rows(8).Resize(lLastrowBG_pol15).PasteSpecial Paste:=xlPasteFormats

        If bPolyBooks Then wbAct.Close False
    Next li
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic

End Sub

Перейти

ВПР vs Индекс(поискпоз) - что легче?

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

25.06.2018 12:02:42

Всем добрый день. Наверняка уже освещался вопрос по поводу того, что из предложенных формул является легче: впр или индекспоискпоз. Подкиньте пожалуйста статей или просто поясните, что оптимальнее использовать при больших выборках
Спасибо!

Перейти

Автоматическое "Включить содержимое"

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

26.04.2018 17:17:15

Коллеги, всем доброго вечера.
Прошу помощи для того, чтобы при открытии книги не приходилось нажимать вверху листа "Включить содержимое". Как прописать это кодом, чтобы прожималось автоматически?
Спасибо!

Изменено: vadik-ceo - 26.04.2018 17:17:51

Перейти

Блокировка выделения нескольких ячеек

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

20.04.2018 12:23:21

Коллеги, добрый день.
Предыстория: лист заблочен, разрешен ввод на некоторые лишь диапазоны ячеек. Выделить заблокированные нельзя.
Хочу, чтобы пользователи не могли выделять на листе более одной ячейки. Подскажите, пожалуйста, как прописать запрет на выделение нескольких ячеек?
Есть у меня следующий код, но, к сожалению, не пашет.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
   MsgBox "Угроза похищения данных! Срочно отключите устройство от сети!"
Else
...
End if

Изменено: vadik-ceo - 20.04.2018 12:24:02

Перейти

Ошибка при обращении к диапазону "application defined or object defined error"

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

11.04.2018 12:49:34

Коллеги, добрый день.
Подскажите, пожалуйста, в чем ошибка по 5 строке?
Точнее, даже знаю, что проблема в Cells(j,2) - вставил просто ячейку (А5), все ок. Но нужен именно диапазон из серии ((Cells(j, 6), Cells(j, 13)).
В противном случае, прошу помочь правильно объявить диапазон.
Спасибо!

Код

a = 6
j = 17
lLastrow3 = Sheets("Лист").Cells(Rows.Count, 5).End(xlUp).Row
FName = Sheets("SETT").Cells(a, 4).Value
Workbooks(FName).Sheets("1").Range((Cells(j, 6), Cells(j, 13)).Copy Destination:=Workbooks("Книга.xlsm").Sheets("Лист").Cells(lLastrow3 + 1, 5) 'ошибка

Изменено: vadik-ceo - 11.04.2018 13:12:42

Перейти

Код под выделение и вставку строки

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

05.04.2018 17:58:15

Ребята, есть следующий вопрос: нужно выделить, предположим три ячейки в столбце "А", стоящие ниже заданной (пусть А1), вырезать их (или копировать) и вставить в столбец "B" (начальная ячейка B1). Можно ли как-то избежать следующей большой конструкции:

Код
Range("A2:A4").Select Selection.Copy Range("B1").Paste

И заменить на одну строку кода?
Процедура, вроде как должна быть понятна, файл не прилагаю.
Спасибо.

Перейти

VBA: как вызвать ячейку с номером ряда Nothing

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

02.04.2018 09:43:27

Друзья, не могу никак разрешить проблему с предыдущих тем (писал по поводу вырезания и вставления строк на одном листе).
С макросом (назвал его Archive) разобрался, написал. Но, извините за выражение, работает один раз, потом ошибки на Insert либо на объявление ячейки "zx" для CurrentRegion перед циклом Do...Loop- делается Empty. На лист "ПЛК", где работает данный макрос Archive, выведен еще один работающий при изменениях листа макрос. Есть предположение, что они конфликтуют.
Очень прошу помощи, сроки горят, файл прикладываю.

Перейти

application defined or object defined error 1004

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

30.03.2018 16:32:19

Ребят, подскажите пожалуйста, в чем трабл. Ошибка
Проверил на отдельном модуле, все работает, значение находит (ячейка не пустая).

Код

Application.ScreenUpdating = False 
zx = Range("B:B").Find("Òåêóùèå çàÿâêè").Offset(1, 0).Row 'application defined or object defined error 1004
Set CR0 = Cells(zx, 2).CurrentRegion
p0 = CR0.Row + 1
i = p0

Изменено: vadik-ceo - 30.03.2018 16:32:54

Перейти

Вырезание строк и вставка на том же листе (VBA)

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

29.03.2018 16:43:38

Ребят, нет слов, одни эмоции. День бьюсь над следующей задачей.

На одном листе одновременно размещены три диапазона ячеек. Первый диапазон - с шапкой "январь", второй диапазон располагается под первым через 1 пустую строчку и имеет шапку "февраль". Третий диапазон расположен под вторым так же через строчку пустую и называется "текущие заявки".
Нужно сделать цикл (или фиг его знает уже что) такой, чтобы проверял строки диапазона "Текущие заявки" и если в столбце U видел слово "факт" и в столбце W "фев/янв", то вырезал ее и переносил в диапазон "Январь" или "Февраль" соответственно.

Моя логика строится на задании диапазонов CurrentRegion. То есть, я определяю последнюю строку диапазона, вставляю вырезанные после нее.
Все бы супер, и получается для одного раза в цикле. Но... Самая главная проблема заключается в том, что первая строка диапазона "Текущие заявки" при вырезании имеющихся всегда будет уходить вниз на количество вырезанных (в нашем случае при каждом круге цикла на 1).

Вот мой код для "Января" (сделал только один месяц) хотя бы реализовать для одного месяца.

Код

Sub ffff()  
Zx = Range("B:B").Find("Текущие заявки").Offset(1, 0).Row
    Zy = Range("B:B").Find("Текущие заявки").Offset(1, 0).Column
    Set CR2 = Cells(Zx + 1, Zy).CurrentRegion
    p1 = CR2.Row
    p2 = CR2.Rows.Count
    p3 = CR2.Row + CR2.CurrentRegion.Rows.Count - 1
    For i = p1 To p3
        If Cells(i, 21).Value = "ФАКТ" Then
           If Cells(i, 19).Value = "янв" Then
              Zx1 = Range("B:B").Find("янв").Offset(1, 0).Row
              Zy1 = Range("B:B").Find("янв").Offset(1, 0).Column
              Set Jan = Cells(Zx1, Zy1).CurrentRegion
              j1 = Jan.Row
              j2 = Jan.Rows.Count
              j3 = Jan.Row + Jan.CurrentRegion.Rows.Count - 1
              Rows(i).Select
              Selection.Cut
              Rows(j3 + 1).Insert
           End If
        End If
    Next
Next
End Sub

Изменено: vadik-ceo - 29.03.2018 17:07:50

Перейти

Возможность изменения ячейки при условии

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

23.03.2018 13:43:58

Ребят, нужна помощь.
Кейс следующий: есть столбец (пусть будет C:C), в каждой ячейке которой есть выпадающий список. Нужно так, чтобы можно было изменять данные в ячейках этого столбца лишь при условии, что в ячейке напротив, например, столбца B:B стоит заданное значение (для условности "1"). То есть, если в ячейке B2 стоит "0" или другое число, то ячейку С2 изменить нельзя.

Есть такие наработки:
Нашел на форуме макрос, который запускает какое-либо действие при любом изменении ячейки в заданном столбце, но не понимаю, как вывести ячейку, (ее координаты) стоящую напротив, чтобы задать на нее условие.

Буду рад если не коду, то хотя бы здравой логике)

Перейти

Макрос на поиск значений из диапазона в другом массиве (диапазоне) данных

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

21.03.2018 13:00:25

Всем привет!
Есть следующий кейс: на листе 3 располагаются некоторые ключи в определенном столбце. Мне нужно проверить каждое значение в этом столбце в массиве (или диапазоне, не уверен как будет верно) данных на другом листе. Если встречается данное значение, то в соседнем столбце проставить 0, если нет 1.
Написал следующее, к сожалению, выдает ошибку invalid qualifier (ругается на d2 в условии). Прошу помощи.

Код

Sub UniqueValues()
Dim d1(), d2()
lLastrow = Sheets("3").Cells(Rows.Count, 1).End(xlUp).Row
d1 = Sheets("4").Range("H2", Cells(Rows.Count, 8).End(xlUp))
d2 = Sheets("3").Range("I2", Cells(Rows.Count, 9).End(xlUp))
For j = 1 To lLastrow - 1
    If d2.Cells(j + 1, 9).Value = d1.Cells(j + 1, 8).Value Then Sheets("3").Cells(j + 1, 10) = 0 Else Sheets("3").Cells(j + 1, 10) = 1
Next
End Sub

Перейти

Ошибка "type mismatch"

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

20.03.2018 11:15:45

Народ, добрый день всем.
В кое-то веки сам смог написать код работающий под загрузку данных (был для одного файла - как пробник). Решил сделать аналогичную операцию для ряда похожих файлов, чтобы выбирал пути и подгружал данные циклом. То есть, цикл должен по моей задумке пройтись по некоторым ячейкам в столбце последовательно, где указаны пути к папкам.
Начала вылезать ошибка "type mismatch" error 13. Подскажите плиз, что не так... Дебажит на строку цикла For.
Всем добра!

Код

Sub Consolidate()      'Макрос открытия файла
Dim wb As Workbook
Dim rc&, rn&, i As Long
Application.ScreenUpdating = False
'rn = Sheets("1").Cells(2, 12)
rc = Sheets("1").Cells(Rows.Count, 12).End(xlUp).Row
i = i + 1
For a = Sheets("1").Cells(i, 12) To rc
    FilePath = Sheets("1").Cells(i, 12).Value
    Workbooks.Open Filename:=FilePath
    Sheets("1_Портфель привлечений").Select
    Range("A6:E9").Select
    Selection.Copy
    Workbooks("Проба.xlsm").Activate
    ActiveWorkbook.Sheets("2").Select
    lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
    Set R = ActiveWorkbook.Sheets("2").Cells(lLastrow + 1, 1)
    R.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ActiveWorkbook Then    ' если это не этот файл
           If wb.Windows(1).Visible Then wb.Close False  ' закрываем его
        End If
    Next wb
Next
Application.ScreenUpdating = True
End Sub

Перейти

Макрос консолидации данных из других файлов Excel

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

18.03.2018 17:09:35

Всем привет. Очень нужна помощь с макросом на консолидацию данных с других файлов Excel.
Суть вопроса: есть в определенном столбце уже готовые пути к нужным файлам. Как сделать цикл (или хотя бы просто саму формулу), который пройдется по всем этим путям и соберет данные на нужный лист.
Заранее спасибо!

Перейти

Подтягивание данных из других файлов

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

15.03.2018 19:43:14

Форумчане, доброго времени суток! Очень нужна помощь..
Есть следующий кейс: нужно консолидировать на лист данные из других книг, причем делать это по тем путям (к файлам), которые будут указаны в n-ом столбце данной книги (то есть, как я понимаю, цикл, который будет перебирать все пути и подгружать из книг определенные диапазоны с определенных листов).
А следующим шагом должно быть добавление с консолидированного листа в другой уникальных значений (типа ВПР, но там 10ки тысяч строк будут, боюсь зависнет), в котором сохраняется вся история кумулятивно (то есть, добавили раз, там осталось, потом сконсолидировали еще раз, в этот список из консо новые уникальные добавились и тд.)
Горит уже, честно говоря, от неумения кодить....

Примерно в эксельке забил листы и вот начало кода, что смог придумать:

Sub Консолидация ()
Dim iBeginRange As Object
Dim sSheetName As String, bPasteValues As String, File As String
Dim Title As String
Dim rn&, rc&
Dim wsDataSheet As Object

On Error Resume Next
Set iBeginRange = Range("A3:H10")
sSheetName = "Заявки"
rn = Cells(J3)
rc = Range(("J3"), Range(("J3"), .End(xlDown)))
Set wsDataSheet = ActiveWorkbook.Sheets("СВОД")

For i = rn To rc
File = Application.GetOpenFilename(rn)

Изменено: vadik-ceo - 15.03.2018 19:46:50

Перейти

Добавление пустой строки после выделенной на листе со счетчиком типа 1.1.1.

vadik-ceo

Пользователь

Сообщений: 68 Регистрация: 12.03.2018

12.03.2018 18:28:28

Всем доброго времени суток. Нужна помощь опытных коллег, так как сам в VBA новичок.
Кейс следующий: нужен макрос на добавление пустой строки (желательно с сохранением формата предыдущей) с учетом того, что каждая новая строка будет иметь свой id (образно говоря, в столбце А будет счетчик с каждой новой строкой: 1.1.1., 1.1.2 ...... 1.2.1. и далее, то есть смотрит на предыдущее значение (формат текстовый)).
Попытался сам состряпать, но вышло что-то не совсем путевое:

Код

Sub InsertRow()
Dim i As Long, rCell As Range
Dim ind%, i%
    For Each rCell In Selection
        If rCell <> "" Then
            If rCell.Offset(1, 0) <> rCell Then
            rCell.Offset(1, 0).EntireRow.Insert
            For ind = 1 To 20000 Step 1
                i = i + 1
                Cells(i, 1).Value = ind
            Next
         End If
     Next
End Sub

Было бы совсем круто, если бы при выполнении макроса выскакивало сообщение с запросом на ввод количества вставляемых строк.
Заранее спасибо!

Перейти