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

 

= Мир MS Excel/Задействовать другой лист - Мир MS Excel

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

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

Есть код, который добавляет в определенные колонки значения

Sub load_data()
    Dim avFiles, x, lr, colnum, i, k, rownum As Long
    Dim wbs As Workbook
    Dim wss, wsd As Worksheet
    Dim MaterialRate, _
        Mat_no, _
        Articleno, _
        ManufSiteCode, _
        Article_Thk, _
        Article_Description, _
        Date_of_report As Integer
    Dim rg As Range
    Dim lastsave As String

    
    Set wsd = Excel.ActiveWorkbook.Sheets(2)
    
    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
    lr = 2
    While (wsd.Range("A" & lr).Value <> "")
        lr = lr + 1
    Wend
    For Each x In avFiles
        Set wbs = Excel.Workbooks.Open(x)
        Set wss = wbs.Sheets(2)
        colnum = Module3.FindLastCol(1, wss)
        rownum = Module3.FindLastRow(123, wss)
        lastsave = wbs.BuiltinDocumentProperties("Last save time").Value
        lastsave = Mid(lastsave, 1, 10)
        For k = 1 To colnum Step 1
            If (wss.Cells(1, k).Value = "MaterialRate") Then MaterialRate = k
            If (wss.Cells(1, k).Value = "Mat.no") Then Mat_no = k
            If (wss.Cells(1, k).Value = "Articleno") Then Articleno = k
            If (wss.Cells(1, k).Value = "Article Description") Then Article_Description = k
            If (wss.Cells(1, k).Value = "Date of report") Then Date_of_report = k
            If (wss.Cells(1, k).Value = "Article Thk") Then Article_Thk = k
            If (wss.Cells(1, k).Value = "ManufSiteCode") Then ManufSiteCode = k
        Next
        For k = 2 To rownum Step 1
            If (wss.Cells(k, MaterialRate).Value <> "") Then
                wsd.Range("A" & lr).Value = wss.Cells(k, MaterialRate).Value
                wsd.Range("B" & lr).Value = wss.Cells(k, Mat_no).Value
                wsd.Range("C" & lr).Value = wss.Cells(k, Articleno).Value
                wsd.Range("D" & lr).Value = wss.Cells(k, ManufSiteCode).Value
                wsd.Range("E" & lr).Value = wss.Cells(k, Article_Thk).Value
                wsd.Range("F" & lr).Value = wss.Cells(k, Article_Description).Value
                wsd.Range("G" & lr).Value = lastsave
                lr = lr + 1
            End If
        Next
        wbs.Close (False)
    Next
End Sub



Сейчас эти колонки находятся на первом листе. А как поменять, если колонки стали находится на втором листе? И можно ли привязать название к листу (например Price Data) ?
 
Ответить
СообщениеВсем доброго времени суток!

Есть код, который добавляет в определенные колонки значения

[vba]
Sub load_data()    Dim avFiles; x; lr; colnum; i; k; rownum As Long    Dim wbs As Workbook    Dim wss; wsd As Worksheet    Dim MaterialRate; _        Mat_no; _        Articleno; _        ManufSiteCode; _        Article_Thk; _        Article_Description; _        Date_of_report As Integer    Dim rg As Range    Dim lastsave As String        Set wsd = Excel.ActiveWorkbook.Sheets(2)        avFiles = Application.GetOpenFilename _                ("Excel files(*.xls*),*.xls*"; 1; "Выбрать Excel файлы"; ; Тrue)    If VarТype(avFiles) = vbBoolean Then        Exit Sub    End If    lr = 2    While (wsd.Range("A" & lr).Value <> "")        lr = lr + 1    Wend    For Each x In avFiles        Set wbs = Excel.Workbooks.Open(x)        Set wss = wbs.Sheets(2)        colnum = Module3.FindLastCol(1; wss)        rownum = Module3.FindLastRow(123; wss)        lastsave = wbs.BuiltinDocumentProperties("Last save time").Value        lastsave = Mid(lastsave; 1; 10)        For k = 1 To colnum Step 1            If (wss.Cells(1; k).Value = "MaterialRate") Then MaterialRate = k            If (wss.Cells(1; k).Value = "Mat.no") Then Mat_no = k            If (wss.Cells(1; k).Value = "Articleno") Then Articleno = k            If (wss.Cells(1; k).Value = "Article Description") Then Article_Description = k            If (wss.Cells(1; k).Value = "Date of report") Then Date_of_report = k            If (wss.Cells(1; k).Value = "Article Тhk") Then Article_Thk = k            If (wss.Cells(1; k).Value = "ManufSiteCode") Then ManufSiteCode = k        Next        For k = 2 To rownum Step 1            If (wss.Cells(k; MaterialRate).Value <> "") Then                wsd.Range("A" & lr).Value = wss.Cells(k; MaterialRate).Value                wsd.Range("B" & lr).Value = wss.Cells(k; Mat_no).Value                wsd.Range("C" & lr).Value = wss.Cells(k; Articleno).Value                wsd.Range("D" & lr).Value = wss.Cells(k; ManufSiteCode).Value                wsd.Range("E" & lr).Value = wss.Cells(k; Article_Thk).Value                wsd.Range("F" & lr).Value = wss.Cells(k; Article_Description).Value                wsd.Range("G" & lr).Value = lastsave                lr = lr + 1            End If        Next        wbs.Close (False)    NextEnd Sub
[/vba]

Сейчас эти колонки находятся на первом листе. А как поменять, если колонки стали находится на втором листе? И можно ли привязать название к листу (например Price Data) ?

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

Excel 2019
Решение найдено:

Нужно было всего лишь задать условие здесь

Set wsd = Excel.ActiveWorkbook.Sheets("Price Data")

 
Ответить
СообщениеРешение найдено:

Нужно было всего лишь задать условие здесь

[vba]
Set wsd = Excel.ActiveWorkbook.Sheets("Price Data")
[/vba]

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

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