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

Вход

Регистрация

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

 

= Мир MS Excel/Debug на нахождение листа - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Debug на нахождение листа
Oh_Nick Дата: Воскресенье, 20.08.2023, 16:16 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Всем доброго времени суток!

С чем может быть связан debug? Подсвечивает:

[vba]
Код
Set ws1 = wb.Worksheets("Sheet1")
[/vba]

Хотя название листа указано верно...
 
Ответить
СообщениеВсем доброго времени суток!

С чем может быть связан debug? Подсвечивает:

[vba]
Код
Set ws1 = wb.Worksheets("Sheet1")
[/vba]

Хотя название листа указано верно...

Автор - Oh_Nick
Дата добавления - 20.08.2023 в 16:16
Oh_Nick Дата: Воскресенье, 20.08.2023, 16:27 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Собственно сам код:

[vba]
Код
Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim file1 As Variant
    Dim file2 As Variant
    
    ' Выбор файла 1
    file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls")
    If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
    
    ' Выбор файла 2
    file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls")
    If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
    
    Set wb = Workbooks.Open(file1)
    Set ws1 = wb.Worksheets("Sheet1")
    
    Set wb2 = Workbooks.Open(file2)
    Set ws2 = wb2.Worksheets("Юр. лица")
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row
    
    For i = 2 To lastRow1
        
        If ws1.Range("BC" & i).Value = "нет" Then
        
            lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row
            
            ws1.Range("AA" & i).Value = ws2.Range("C" & lastRow2 + 1).Value
            ws1.Range("AB" & i).Value = ws2.Range("D" & lastRow2 + 1).Value
            ws1.Range("BN" & i).Value = ws2.Range("E" & lastRow2 + 1).Value
            
        End If
        
    Next i
    
    wb.Save
    wb.Close
    wb2.Save
    wb2.Close

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb = Nothing
    Set wb2 = Nothing

End Sub
[/vba]

Должен если в файле 1 в колонке BC стоит слово Нет, то он должен перенести в файл 2 значения с колонки АА в колонку С, с колонки AB в колонку D, с колонки BN в колонку E
 
Ответить
СообщениеСобственно сам код:

[vba]
Код
Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim file1 As Variant
    Dim file2 As Variant
    
    ' Выбор файла 1
    file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls")
    If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
    
    ' Выбор файла 2
    file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls")
    If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
    
    Set wb = Workbooks.Open(file1)
    Set ws1 = wb.Worksheets("Sheet1")
    
    Set wb2 = Workbooks.Open(file2)
    Set ws2 = wb2.Worksheets("Юр. лица")
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row
    
    For i = 2 To lastRow1
        
        If ws1.Range("BC" & i).Value = "нет" Then
        
            lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row
            
            ws1.Range("AA" & i).Value = ws2.Range("C" & lastRow2 + 1).Value
            ws1.Range("AB" & i).Value = ws2.Range("D" & lastRow2 + 1).Value
            ws1.Range("BN" & i).Value = ws2.Range("E" & lastRow2 + 1).Value
            
        End If
        
    Next i
    
    wb.Save
    wb.Close
    wb2.Save
    wb2.Close

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb = Nothing
    Set wb2 = Nothing

End Sub
[/vba]

Должен если в файле 1 в колонке BC стоит слово Нет, то он должен перенести в файл 2 значения с колонки АА в колонку С, с колонки AB в колонку D, с колонки BN в колонку E

Автор - Oh_Nick
Дата добавления - 20.08.2023 в 16:27
MikeVol Дата: Воскресенье, 20.08.2023, 19:46 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Oh_Nick, Здравствуйте. А file1 если его открыть самому (в ручную) нет никакой ошибки при открытие? Возможно сам файл повреждён. И ещё раз проверьте правильность название Листа, возможно всё же есть ошибка в название.


Ученик.
 
Ответить
СообщениеOh_Nick, Здравствуйте. А file1 если его открыть самому (в ручную) нет никакой ошибки при открытие? Возможно сам файл повреждён. И ещё раз проверьте правильность название Листа, возможно всё же есть ошибка в название.

Автор - MikeVol
Дата добавления - 20.08.2023 в 19:46
Oh_Nick Дата: Понедельник, 21.08.2023, 08:23 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
MikeVol, Прикрепил два файла
К сообщению приложен файл: 1896754.xlsm (274.3 Kb) · 9433809.xlsx (36.7 Kb)
 
Ответить
СообщениеMikeVol, Прикрепил два файла

Автор - Oh_Nick
Дата добавления - 21.08.2023 в 08:23
Gustav Дата: Понедельник, 21.08.2023, 10:44 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2759
Репутация: 1140 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Oh_Nick, а Вас не смущает, что Вы кодом из первого файла (который с макросом) пытаетесь открыть/открываете этот же самый файл повторно? Меня так очень смущает...


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеOh_Nick, а Вас не смущает, что Вы кодом из первого файла (который с макросом) пытаетесь открыть/открываете этот же самый файл повторно? Меня так очень смущает...

Автор - Gustav
Дата добавления - 21.08.2023 в 10:44
MikeVol Дата: Понедельник, 21.08.2023, 11:09 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Oh_Nick, И ещё, у вас таблица не начинается со второй строки как у вас в цикле: For i = 2 To lastRow1
Вроде вы давно тут на форуме, должны быть уже более на опыте, скажем так. Ну а код должен быть вот таким по итогу:
[vba]
Код
Option Explicit

Sub add()
    Dim i           As Long

    '    ' Выбор файла 1
    '    Dim file1       As Variant: file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls")
    '    If file1 = False Then Exit Sub    ' Проверка на отмену выбора файла

    ' Выбор файла 2
    Dim file2       As Variant: file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls")
    If file2 = False Then Exit Sub    ' Проверка на отмену выбора файла

    Dim wb          As Workbook: Set wb = ActiveWorkbook    ' Workbooks.Open(file1)
    Dim ws1         As Worksheet: Set ws1 = wb.Worksheets("Sheet1")

    Dim wb2         As Workbook: Set wb2 = Workbooks.Open(file2)
    Dim ws2         As Worksheet: Set ws2 = wb2.Worksheets("Юр. лица")

    Dim lastRow1    As Long: lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row

    For i = 8 To lastRow1

        If ws1.Range("BC" & i).Value = "нет" Then

            Dim lastRow2 As Long: lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row

            ws1.Range("AA" & i).Value = ws2.Range("C" & lastRow2 + 1).Value
            ws1.Range("AB" & i).Value = ws2.Range("D" & lastRow2 + 1).Value
            ws1.Range("BN" & i).Value = ws2.Range("E" & lastRow2 + 1).Value
        End If

    Next i

    '    wb.Save
    '    wb.Close
    wb2.Save
    wb2.Close

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb = Nothing
    Set wb2 = Nothing
End Sub
[/vba]
Gustav, прав, вы
пытаетесь открыть/открываете этот же самый файл повторно


Ученик.

Сообщение отредактировал MikeVol - Понедельник, 21.08.2023, 11:10
 
Ответить
СообщениеOh_Nick, И ещё, у вас таблица не начинается со второй строки как у вас в цикле: For i = 2 To lastRow1
Вроде вы давно тут на форуме, должны быть уже более на опыте, скажем так. Ну а код должен быть вот таким по итогу:
[vba]
Код
Option Explicit

Sub add()
    Dim i           As Long

    '    ' Выбор файла 1
    '    Dim file1       As Variant: file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls")
    '    If file1 = False Then Exit Sub    ' Проверка на отмену выбора файла

    ' Выбор файла 2
    Dim file2       As Variant: file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls")
    If file2 = False Then Exit Sub    ' Проверка на отмену выбора файла

    Dim wb          As Workbook: Set wb = ActiveWorkbook    ' Workbooks.Open(file1)
    Dim ws1         As Worksheet: Set ws1 = wb.Worksheets("Sheet1")

    Dim wb2         As Workbook: Set wb2 = Workbooks.Open(file2)
    Dim ws2         As Worksheet: Set ws2 = wb2.Worksheets("Юр. лица")

    Dim lastRow1    As Long: lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row

    For i = 8 To lastRow1

        If ws1.Range("BC" & i).Value = "нет" Then

            Dim lastRow2 As Long: lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row

            ws1.Range("AA" & i).Value = ws2.Range("C" & lastRow2 + 1).Value
            ws1.Range("AB" & i).Value = ws2.Range("D" & lastRow2 + 1).Value
            ws1.Range("BN" & i).Value = ws2.Range("E" & lastRow2 + 1).Value
        End If

    Next i

    '    wb.Save
    '    wb.Close
    wb2.Save
    wb2.Close

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb = Nothing
    Set wb2 = Nothing
End Sub
[/vba]
Gustav, прав, вы
пытаетесь открыть/открываете этот же самый файл повторно

Автор - MikeVol
Дата добавления - 21.08.2023 в 11:09
Oh_Nick Дата: Понедельник, 21.08.2023, 11:17 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
MikeVol, не претендую на опытность, поэтому спрашиваю профессионалов здесь) кстати ничего не перенеслось (
 
Ответить
СообщениеMikeVol, не претендую на опытность, поэтому спрашиваю профессионалов здесь) кстати ничего не перенеслось (

Автор - Oh_Nick
Дата добавления - 21.08.2023 в 11:17
MikeVol Дата: Понедельник, 21.08.2023, 15:51 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
кстати ничего не перенеслось
так у вас ничего и не перенесёться, вы просто пытаетесь копировать из одной книги в другую. И то, не совсем понятно что вы пытаетесь сделать этим кодом. Разве что просто открыть вторую книгу и всё! В этом кусочке кода [vba]
Код
ws2.Range("C" & lastRow2 + 1).Value
[/vba] вы просто типа копируете первую пустую ячейку с листа второй книги которую вы открыли.
Вы можете просто объяснить что вам вообще надо получить в конечно результате и не прикладывая чужих кодов которые вообще не подходят вам?


Ученик.
 
Ответить
Сообщение
кстати ничего не перенеслось
так у вас ничего и не перенесёться, вы просто пытаетесь копировать из одной книги в другую. И то, не совсем понятно что вы пытаетесь сделать этим кодом. Разве что просто открыть вторую книгу и всё! В этом кусочке кода [vba]
Код
ws2.Range("C" & lastRow2 + 1).Value
[/vba] вы просто типа копируете первую пустую ячейку с листа второй книги которую вы открыли.
Вы можете просто объяснить что вам вообще надо получить в конечно результате и не прикладывая чужих кодов которые вообще не подходят вам?

Автор - MikeVol
Дата добавления - 21.08.2023 в 15:51
Gustav Дата: Понедельник, 21.08.2023, 16:28 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2759
Репутация: 1140 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Oh_Nick, конструкции типа:
[vba]
Код
ws2.Range("C" & lastRow2 + 1)
[/vba]
имеет смысл через Cells оформить - не будет лишней операции конкатенации для вычислении адреса:
[vba]
Код
ws2.Cells(lastRow2 + 1, "C")
[/vba]
Обратите внимание, что по сравнению с Range строки и колонки в скобках поменялись местами.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеOh_Nick, конструкции типа:
[vba]
Код
ws2.Range("C" & lastRow2 + 1)
[/vba]
имеет смысл через Cells оформить - не будет лишней операции конкатенации для вычислении адреса:
[vba]
Код
ws2.Cells(lastRow2 + 1, "C")
[/vba]
Обратите внимание, что по сравнению с Range строки и колонки в скобках поменялись местами.

Автор - Gustav
Дата добавления - 21.08.2023 в 16:28
Oh_Nick Дата: Понедельник, 21.08.2023, 16:39 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
MikeVol, Gustav,

спасибо, попробую покопаться сам
 
Ответить
СообщениеMikeVol, Gustav,

спасибо, попробую покопаться сам

Автор - Oh_Nick
Дата добавления - 21.08.2023 в 16:39
  • Страница 1 из 1
  • 1
Поиск:

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