Автор Тема: Word VBA Макросы: как извлечь данные из excel-файла в массив  (Прочитано 56 раз)

Оффлайн Daikiny

  • Посетитель форума
  • Сообщений: 5
Помогите написать макрос, чтобы брать данные в массив из эксель-файла.

Оффлайн Администратор

  • Administrator
  • Сообщений: 1622
Макрос
Sub Макрос()

    Dim phrases()
   
    ' Запись искомых фраз из эксель-файла в массив 'phrases'.
    GetSearchPhrases phrases()
   
    ' Здесь у вас массив 'phrases' с искомыми словами.
        ' Массив двумерный: состоит из нескольких строк и одного столбца.
        ' Чтобы извлечь первый элемент: phrases(1,1), чтобы извлечь второй элемент: phrases(2,1) и т.д.

End Sub

Private Sub GetSearchPhrases(phrases())

     ' Запись искомых фраз из эксель-файла в массив 'phrases'.
       
    Dim ex As Object, bk As Object, sh As Object
    Dim FN As String, lr As Long

   
    '1. Запуск экселя.
    Set ex = CreateObject(Class:="Excel.Application")
   
    '2. Открытие эксель-файла. Файлу присваиваем имя 'bk' и далее в коде
        ' можно обращаться к файлу по этому имени.
        ' Файл открывается только для чтения, т.к. нам надо только извлечь данные,
        ' а записывать данные не надо. Это позволит избежать конфликта, если файл кем-то открыт.
    ' В переменной 'FN' укажите полное имя (путь + имя) эксель-файла.
    FN = "C:\Users\User\Desktop\Искомые фразы.xlsb"
    Set bk = ex.Workbooks.Open(FileName:=FN, ReadOnly:=True)
   
    '3. Даём имя 'sh' листу, из которого надо извлечь данные.
        ' Далее в макросе будем обращаться к листу по этому имени.
    Set sh = bk.Worksheets("Фразы")
   
    '4. Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = sh.Cells(sh.Rows.Count, "A").End(-4162).Row
   
    '5. Копирование данных из столбца A со второй строки до последней в массив.
    phrases() = sh.Range("A2:A" & lr).Value
   
    '6. Закрытие файла и экселя.
    bk.Close SaveChanges:=False
    ex.Quit
   
End Sub

В самый верх модуля вставьте это. Я делал макрос, при этих настройках:
Option Explicit
Option Compare Text
Option Base 1

Оффлайн Daikiny

  • Посетитель форума
  • Сообщений: 5
Спасибо. По итогу меня есть макрос 1 и 2 , но соединить их у  меня не получается.

макрос по взятию данных из таблицы

Спойлер
Option Explicit
Option Compare Text
Option Base 1

Sub Макрос()

    Dim phrases()
   
    ' Запись искомых фраз из эксель-файла в массив 'phrases'.
    GetSearchPhrases phrases()
   
    ' Здесь у вас массив 'phrases' с искомыми словами.
        ' Массив двумерный: состоит из нескольких строк и одного столбца.
        ' Чтобы извлечь первый элемент: phrases(1,1), чтобы извлечь второй элемент: phrases(2,1) и т.д.

End Sub

Private Sub GetSearchPhrases(phrases())

     ' Запись искомых фраз из эксель-файла в массив 'phrases'.
       
    Dim ex As Object, bk As Object, sh As Object
    Dim FN As String, lr As Long

   
    '1. Запуск экселя.
    Set ex = CreateObject(Class:="Excel.Application")
   
    '2. Открытие эксель-файла. Файлу присваиваем имя 'bk' и далее в коде
        ' можно обращаться к файлу по этому имени.
        ' Файл открывается только для чтения, т.к. нам надо только извлечь данные,
        ' а записывать данные не надо. Это позволит избежать конфликта, если файл кем-то открыт.
    ' В переменной 'FN' укажите полное имя (путь + имя) эксель-файла.
    FN = "/Users/macos/Yandex.Disk.localized/www.tradelikeapro.ru/forum.tradelikeapro/Искомые фразы.xlsb"
    Set bk = ex.Workbooks.Open(FileName:=FN, ReadOnly:=True)
   
    '3. Даём имя 'sh' листу, из которого надо извлечь данные.
        ' Далее в макросе будем обращаться к листу по этому имени.
    Set sh = bk.Worksheets("Фразы")
   
    '4. Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = sh.Cells(sh.Rows.Count, "A").End(-4162).Row
   
    '5. Копирование данных из столбца A со второй строки до последней в массив.
    phrases() = sh.Range("A2:A" & lr).Value
   
    '6. Закрытие файла и экселя.
    bk.Close SaveChanges:=False
    ex.Quit
   
End Sub

макрос по измению цвета

Спойлер
Sub Макрос()
   
    ' Создаём в оперативной памяти компьютера массив с двумя элементами.
    Dim SearchWords(2)
    Dim i As Long
   
   
    '1. Записываем в массив 'SearchWords' искомые слова.
    SearchWords(1) = "цена"
    SearchWords(2) = "флэт"
   
    '2. Поиск и закраска искомых слов.
   
    '1) Настройка цвета.
    Options.DefaultHighlightColorIndex = wdYellow
   
    '2) Просматриваем элементы массива 'SearchWords'.
    For i = 1 To UBound(SearchWords)
       
        ' Поиск и замена.
        With ActiveDocument.Range.Find
            ' В параметр 'Text' подставляем текущий элемент массива.
            .Text = SearchWords(i)
            .Replacement.Highlight = True
            .Execute Replace:=wdReplaceAll
        End With
   
    Next i
   
    ' Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Благодарю.

Оффлайн Администратор

  • Administrator
  • Сообщений: 1622
В FN у вас нестандартная ситуация: полное имя начинается с одного слеша. Если это локальная сеть, то должно быть два слеша. В вашем же случае я не понимаю, что происходит. Что спереди подставит макрос в FN я не знаю.

Макрос
Option Explicit
Option Compare Text
Option Base 1

Sub Макрос()
   
    Dim phrases()
    Dim i As Long
   
   
    '1. Запись искомых фраз из эксель-файла в массив 'phrases'.
    GetSearchPhrases phrases()
   
    '2. Поиск и закраска искомых слов.
   
    '1) Настройка цвета.
    Options.DefaultHighlightColorIndex = wdYellow
   
    '2) Просматриваем элементы массива 'SearchWords'.
    For i = 1 To UBound(phrases)
       
        ' Поиск и замена.
        With ActiveDocument.Range.Find
            ' В параметр 'Text' подставляем текущий элемент массива.
            .Text = phrases(i, 1)
            .Replacement.Highlight = True
            .Execute Replace:=wdReplaceAll
        End With
   
    Next i
   
    '3. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Private Sub GetSearchPhrases(phrases())

     ' Запись искомых фраз из эксель-файла в массив 'phrases'.
       
    Dim ex As Object, bk As Object, sh As Object
    Dim FN As String, lr As Long

   
    '1. Запуск экселя.
    Set ex = CreateObject(Class:="Excel.Application")
   
    '2. Открытие эксель-файла. Файлу присваиваем имя 'bk' и далее в коде
        ' можно обращаться к файлу по этому имени.
        ' Файл открывается только для чтения, т.к. нам надо только извлечь данные,
        ' а записывать данные не надо. Это позволит избежать конфликта, если файл кем-то открыт.
    ' В переменной 'FN' укажите полное имя (путь + имя) эксель-файла.
    FN = "/Users/macos/Yandex.Disk.localized/www.tradelikeapro.ru/forum.tradelikeapro/Искомые фразы.xlsb"
    Set bk = ex.Workbooks.Open(FileName:=FN, ReadOnly:=True)
   
    '3. Даём имя 'sh' листу, из которого надо извлечь данные.
        ' Далее в макросе будем обращаться к листу по этому имени.
    Set sh = bk.Worksheets("Фразы")
   
    '4. Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = sh.Cells(sh.Rows.Count, "A").End(-4162).Row
   
    '5. Копирование данных из столбца A со второй строки до последней в массив.
    phrases() = sh.Range("A2:A" & lr).Value
   
    '6. Закрытие файла и экселя.
    bk.Close SaveChanges:=False
    ex.Quit
   
End Sub

Оффлайн Daikiny

  • Посетитель форума
  • Сообщений: 5
Да я все прочитала, файл поместила на рабочий стол, прикладываю скрин ошибки. Данные находятся в первом столбце, прикладываю файл, уже отредактированный, на всякий случай.

Оффлайн Администратор

  • Administrator
  • Сообщений: 1622
У вас операционная система Mac?
Если да, то, на будущее, надо об этом сообщать, т.к. 100% совместимости нет между офисом для Windows и для Mac.
Даже внутри windows-версий нет 100% совместимости.

Оффлайн Администратор

  • Administrator
  • Сообщений: 1622
Пока идея - нужно отображать эксель на мониторе.

Макрос
Option Explicit
Option Compare Text
Option Base 1

Sub Макрос()
   
    Dim phrases()
    Dim i As Long
   
   
    '1. Запись искомых фраз из эксель-файла в массив 'phrases'.
    GetSearchPhrases phrases()
   
    '2. Поиск и закраска искомых слов.
   
    '1) Настройка цвета.
    Options.DefaultHighlightColorIndex = wdYellow
   
    '2) Просматриваем элементы массива 'SearchWords'.
    For i = 1 To UBound(phrases)
       
        ' Поиск и замена.
        With ActiveDocument.Range.Find
            ' В параметр 'Text' подставляем текущий элемент массива.
            .text = phrases(i, 1)
            .Replacement.Highlight = True
            .Execute Replace:=wdReplaceAll
        End With
   
    Next i
   
    '3. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Private Sub GetSearchPhrases(phrases())

     ' Запись искомых фраз из эксель-файла в массив 'phrases'.
       
    Dim ex As Object, bk As Object, sh As Object
    Dim FN As String, lr As Long

   
    '1. Запуск экселя.
    Set ex = CreateObject(Class:="Excel.Application")
    ex.Visible = True
   
    '2. Открытие эксель-файла. Файлу присваиваем имя 'bk' и далее в коде
        ' можно обращаться к файлу по этому имени.
        ' Файл открывается только для чтения, т.к. нам надо только извлечь данные,
        ' а записывать данные не надо. Это позволит избежать конфликта, если файл кем-то открыт.
    ' В переменной 'FN' укажите полное имя (путь + имя) эксель-файла.
    FN = "/Users/macos/Yandex.Disk.localized/www.tradelikeapro.ru/forum.tradelikeapro/Искомые фразы.xlsb"
    Set bk = ex.Workbooks.Open(FileName:=FN, ReadOnly:=True)
   
    '3. Даём имя 'sh' листу, из которого надо извлечь данные.
        ' Далее в макросе будем обращаться к листу по этому имени.
    Set sh = bk.Worksheets("Фразы")
   
    '4. Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = sh.Cells(sh.Rows.Count, "A").End(-4162).Row
   
    '5. Копирование данных из столбца A со второй строки до последней в массив.
    phrases() = sh.Range("A2:A" & lr).Value
   
    '6. Закрытие файла и экселя.
    bk.Close SaveChanges:=False
    ex.Quit
   
End Sub

Оффлайн Администратор

  • Administrator
  • Сообщений: 1622
В момент запуска макроса, эксель у вас закрыт?