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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных по кнопке - Мир MS Excel

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

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

Пытаюсь написать код:

[vba]
Код
Sub load_data()
    Dim a, i&

    a = ThisWorkbook.Sheets(1).ListObjects(1).DataBodyRange.Value
    For i = 1 To UBound(a)
        Select Case a(i, 1)
        Case "MaterialRate", "Mat.no", "Articleno", "Article Description", "Date of report", "Article Thk", "ManufSiteCode"
            x = x + 1
            a(x, 1) = a(i, 119)
            a(x, 2) = a(i, 122)
            a(x, 3) = a(i, 123)
            a(x, 4) = a(i, 124)
            a(x, 5) = a(i, 126)
            a(x, 6) = a(i, 127)
        End Select
    Next
    With Workbooks("1.xlsx").Sheets("Price Data")
        .[A1].End(xlDown)(2).Resize(x, 5) = a
    End With
End Sub
[/vba]

Должен переносить колонки по нажатию кнопки Generate.

Почему выходит debug?
К сообщению приложен файл: 6680329.xlsx (62.9 Kb) · Price_Data_Coll.xlsm (84.5 Kb)
 
Ответить
СообщениеВсем доброго времени суток!

Пытаюсь написать код:

[vba]
Код
Sub load_data()
    Dim a, i&

    a = ThisWorkbook.Sheets(1).ListObjects(1).DataBodyRange.Value
    For i = 1 To UBound(a)
        Select Case a(i, 1)
        Case "MaterialRate", "Mat.no", "Articleno", "Article Description", "Date of report", "Article Thk", "ManufSiteCode"
            x = x + 1
            a(x, 1) = a(i, 119)
            a(x, 2) = a(i, 122)
            a(x, 3) = a(i, 123)
            a(x, 4) = a(i, 124)
            a(x, 5) = a(i, 126)
            a(x, 6) = a(i, 127)
        End Select
    Next
    With Workbooks("1.xlsx").Sheets("Price Data")
        .[A1].End(xlDown)(2).Resize(x, 5) = a
    End With
End Sub
[/vba]

Должен переносить колонки по нажатию кнопки Generate.

Почему выходит debug?

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

Excel 2019
вот здесь поправил:

[vba]
Код
With Workbooks("1.xlsx").Sheets("SPR_ProjectDownload")
[/vba]

но теперь подсвечивает эту:

[vba]
Код
.[A1].End(xlDown)(2).Resize(x, 5) = a
[/vba]


Сообщение отредактировал Oh_Nick - Понедельник, 26.04.2021, 16:42
 
Ответить
Сообщениевот здесь поправил:

[vba]
Код
With Workbooks("1.xlsx").Sheets("SPR_ProjectDownload")
[/vba]

но теперь подсвечивает эту:

[vba]
Код
.[A1].End(xlDown)(2).Resize(x, 5) = a
[/vba]

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

Excel 2019
Добил код выбором файла:

[vba]
Код
Sub load_data()
    Dim avFiles, x, lr As Long
    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
    lr = 9
    For Each x In avFiles
        Cells(lr, 1).Value = x
        lr = lr + 1
    Next
    Dim a, i&
    a = ThisWorkbook.Sheets(1).ListObjects(1).DataBodyRange.Value
    For i = 1 To UBound(a)
        Select Case a(i, 1)
        Case "MaterialRate", "Mat.no", "Articleno", "Article Description", "Date of report", "Article Thk", "ManufSiteCode"
            x = x + 1
            a(x, 1) = a(i, 119)
            a(x, 2) = a(i, 122)
            a(x, 3) = a(i, 123)
            a(x, 4) = a(i, 124)
            a(x, 5) = a(i, 126)
            a(x, 6) = a(i, 127)
        End Select
    Next
End Sub
[/vba]

Что тут не так?
 
Ответить
СообщениеДобил код выбором файла:

[vba]
Код
Sub load_data()
    Dim avFiles, x, lr As Long
    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
    lr = 9
    For Each x In avFiles
        Cells(lr, 1).Value = x
        lr = lr + 1
    Next
    Dim a, i&
    a = ThisWorkbook.Sheets(1).ListObjects(1).DataBodyRange.Value
    For i = 1 To UBound(a)
        Select Case a(i, 1)
        Case "MaterialRate", "Mat.no", "Articleno", "Article Description", "Date of report", "Article Thk", "ManufSiteCode"
            x = x + 1
            a(x, 1) = a(i, 119)
            a(x, 2) = a(i, 122)
            a(x, 3) = a(i, 123)
            a(x, 4) = a(i, 124)
            a(x, 5) = a(i, 126)
            a(x, 6) = a(i, 127)
        End Select
    Next
End Sub
[/vba]

Что тут не так?

Автор - Oh_Nick
Дата добавления - 26.04.2021 в 17:01
Oh_Nick Дата: Вторник, 27.04.2021, 08:03 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Ребята,

Есть предложения какие-то?
 
Ответить
СообщениеРебята,

Есть предложения какие-то?

Автор - Oh_Nick
Дата добавления - 27.04.2021 в 08:03
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных по кнопке (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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