Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Правильное обращение к книге и перенос данных из нее - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Правильное обращение к книге и перенос данных из нее (Макросы/Sub)
Правильное обращение к книге и перенос данных из нее
trigintillion Дата: Пятница, 12.01.2024, 20:08 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Добрый день. Мне нужно внести изменения в программу, написанную на VBA, но я в этом языке не разбираюсь. Нужно сначала открыть другую книгу, потом при помощи поиска найти в первом столбце этой "другой" книги значение из конкретной ячейки первой книги; после чего в ячейку второй книги, находящейся на пересечении строки, содержащей найденное значение, и третьего столбца, нужно что-нибудь записать. Я всё-таки написал для всего этого рабочий код, но он, к сожалению, отказывается работать из нужного места. В первом столбце второй книги находятся все даты за год.
Вот код, который выполняется при нажатии на кнопку в первой книге. Эта кнопка находится на форме, которая вызывается нажатием кнопки, находящейся на книге. В этот код я пытаюсь вставить собственный, но не получается.
[vba]
Код
Private Sub CBGotovo_Click()
    Dim i As Integer
    Dim ED As Integer
    Dim NN As Integer
    Dim Txt_IK As String
    Dim AdrCol1 As Integer
    Dim AdrRow1 As Integer
    Dim L5_BZ As Worksheet
    Dim Tufta() As Variant
    Application.EnableEvents = False
    ED = Range("Данные").Columns.Count
    If LBSpisok.ListCount = ED Then
        Set L5_BZ = Worksheets("Лист5")
        NN = 11
        Txt_IK = Range("Разнос").EntireColumn(1).Address(ReferenceStyle:=xlR1C1)
        AdrCol1 = Val(Right(Txt_IK, Len(Txt_IK) - 1))
        Txt_IK = Range("Разнос").EntireRow(1).Address(ReferenceStyle:=xlR1C1)
        AdrRow1 = Val(Right(Txt_IK, Len(Txt_IK) - 1))
        ReDim Tufta(1 To ED) As Variant
        For i = 3 To NN
            Tufta = L5_BZ.Range(Cells(2, i).Address, Cells(ED + 1, i).Address).Value
            Worksheets("Лист1").Range(Cells(AdrRow1 + i - 3, AdrCol1).Address, Cells(AdrRow1 + i - 3, AdrCol1 + ED -
            1).Address).Value = Application.WorksheetFunction.Transpose(Tufta)
        Next i
        Unload UFDRaznoski
        Worksheets("Лист5").Range(Cells(2, 1).Address, Cells(ED + 1, NN).Address).ClearContents
        Worksheets("Лист1").Range("Разнос").Cells(1, 1).Offset(-3, 3).Activate
    Else
        MsgBox "Системный сбой! "
        Unload UFDRaznoski
    End If
    Application.EnableEvents = True
    ActiveWorkbook.Save
End Sub
[/vba]
Мой код, который работает из другого места, но не работает из этого.
[vba]
Код
Workbooks.Open (ThisWorkbook.Path & "\R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx") 'Открываем файл R.xlsx за соответствующий год
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Worksheets("Лист1").Cells(Columns(1).Find(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value).Row, 3) = "blabla" 'Выводим данные в файл R.xlsx в соответствующую строку за соответствующий год
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Save 'Сохраняем файл R.xlsx
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Close 'Закрываем файл
[/vba]
Не работает! Пытаюсь, например, вставить только первую строчку, но с записью "Workbooks(Z)" код вообще отказывается выполняться, а если её стереть, то пишет, что не найден файл R1905.xlsx, хотя должен получаться файл R2020.xlsx...
 
Ответить
СообщениеДобрый день. Мне нужно внести изменения в программу, написанную на VBA, но я в этом языке не разбираюсь. Нужно сначала открыть другую книгу, потом при помощи поиска найти в первом столбце этой "другой" книги значение из конкретной ячейки первой книги; после чего в ячейку второй книги, находящейся на пересечении строки, содержащей найденное значение, и третьего столбца, нужно что-нибудь записать. Я всё-таки написал для всего этого рабочий код, но он, к сожалению, отказывается работать из нужного места. В первом столбце второй книги находятся все даты за год.
Вот код, который выполняется при нажатии на кнопку в первой книге. Эта кнопка находится на форме, которая вызывается нажатием кнопки, находящейся на книге. В этот код я пытаюсь вставить собственный, но не получается.
[vba]
Код
Private Sub CBGotovo_Click()
    Dim i As Integer
    Dim ED As Integer
    Dim NN As Integer
    Dim Txt_IK As String
    Dim AdrCol1 As Integer
    Dim AdrRow1 As Integer
    Dim L5_BZ As Worksheet
    Dim Tufta() As Variant
    Application.EnableEvents = False
    ED = Range("Данные").Columns.Count
    If LBSpisok.ListCount = ED Then
        Set L5_BZ = Worksheets("Лист5")
        NN = 11
        Txt_IK = Range("Разнос").EntireColumn(1).Address(ReferenceStyle:=xlR1C1)
        AdrCol1 = Val(Right(Txt_IK, Len(Txt_IK) - 1))
        Txt_IK = Range("Разнос").EntireRow(1).Address(ReferenceStyle:=xlR1C1)
        AdrRow1 = Val(Right(Txt_IK, Len(Txt_IK) - 1))
        ReDim Tufta(1 To ED) As Variant
        For i = 3 To NN
            Tufta = L5_BZ.Range(Cells(2, i).Address, Cells(ED + 1, i).Address).Value
            Worksheets("Лист1").Range(Cells(AdrRow1 + i - 3, AdrCol1).Address, Cells(AdrRow1 + i - 3, AdrCol1 + ED -
            1).Address).Value = Application.WorksheetFunction.Transpose(Tufta)
        Next i
        Unload UFDRaznoski
        Worksheets("Лист5").Range(Cells(2, 1).Address, Cells(ED + 1, NN).Address).ClearContents
        Worksheets("Лист1").Range("Разнос").Cells(1, 1).Offset(-3, 3).Activate
    Else
        MsgBox "Системный сбой! "
        Unload UFDRaznoski
    End If
    Application.EnableEvents = True
    ActiveWorkbook.Save
End Sub
[/vba]
Мой код, который работает из другого места, но не работает из этого.
[vba]
Код
Workbooks.Open (ThisWorkbook.Path & "\R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx") 'Открываем файл R.xlsx за соответствующий год
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Worksheets("Лист1").Cells(Columns(1).Find(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value).Row, 3) = "blabla" 'Выводим данные в файл R.xlsx в соответствующую строку за соответствующий год
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Save 'Сохраняем файл R.xlsx
Workbooks("R" & CStr(Year(Workbooks(Z).Worksheets("Лист1").Range("Дата").Value)) & ".xlsx").Close 'Закрываем файл
[/vba]
Не работает! Пытаюсь, например, вставить только первую строчку, но с записью "Workbooks(Z)" код вообще отказывается выполняться, а если её стереть, то пишет, что не найден файл R1905.xlsx, хотя должен получаться файл R2020.xlsx...

Автор - trigintillion
Дата добавления - 12.01.2024 в 20:08
trigintillion Дата: Суббота, 13.01.2024, 09:05 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Сам разобрался.
 
Ответить
СообщениеСам разобрался.

Автор - trigintillion
Дата добавления - 13.01.2024 в 09:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Правильное обращение к книге и перенос данных из нее (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!