Форум программистов, компьютерный форум, киберфорум
OpenOffice/LibreOffice
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/51: Рейтинг темы: голосов - 51, средняя оценка - 4.80
0 / 0 / 0
Регистрация: 10.04.2012
Сообщений: 25
1

Макрос для Excel в OpenOffice

18.09.2012, 22:01. Показов 10087. Ответов 8
Метки нет (Все метки)

Помогите пожалуйста переделать макрос Excel в макрос для OpenOffice.Calc.
Особенно интересует строчка: a = .Sheets(1).UsedRange.Value

Код
Sub Test()
Dim Book As Excel.Workbook
Dim Sheet As Excel.Worksheet
Dim sFolder As String
Dim sFiles As String
Dim a(), i&, ii&, x As Byte, ILastrow&
Dim oDict As Object
Dim calc_status&
 Dim n As Integer
 Dim RowNo As Integer
sFolder = ThisWorkbook.Path & "\4\"
sFiles = Dir(sFolder & "*.xls")
Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1
With Application
calc_status = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
a = .Sheets(1).UsedRange.Value
For i = 5 To UBound(a)
If Len(a(i, 2)) Then
If Not oDict.exists(a(i, 2)) Then
oDict.Item(a(i, 2)) = 0&
End If
Else
Exit For
End If
Next
Do While sFiles <> ""
With GetObject(sFolder & sFiles)
a = .Sheets(1).UsedRange.Value
ReDim b(1 To UBound(a), 1 To 4)
ii = 0
For i = 5 To UBound(a)
If Len(a(i, 2)) Then
If Not oDict.exists(a(i, 2)) Then
oDict.Item(a(i, 2)) = 0&
ii = ii + 1
For x = 1 To 4: b(ii, x) = a(i, x + 1): Next
End If
Else
Exit For
End If
Next
sFiles = Dir
.Close 0
End With
If ii > 0 Then
ILastrow = Cells(Rows.Count, 5).End(xlUp).Row
Cells(ILastrow + 1, 2).Resize(ii, 4) = b
End If
Loop
.Calculation = calc_status
.ScreenUpdating = True
.EnableEvents = True

  n = 1
    For RowNo = 4 To Range("B4").SpecialCells(xlLastCell).Row - 1
     Лист1.Cells(RowNo + 1, 1) = n
      n = n + 1
    Next RowNo


End With
End Sub
Данный макрос открывает поочереди файлы и записывает -значения из них в текущую книгу, если уже есть данное значение, то пропускает
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
18.09.2012, 22:01
Ответы с готовыми решениями:

Макрос для OpenOffice Calc
Ситуация такая например есть строка: товар (его качества) Цена. Необходимо все что в скобках...

Нужен макрос в OpenOffice Basic
Добрый день! Есть значения в столбце, нужно запомнить их в Массив1. Далее в макросе нужно сделать...

Макрос с запросами в OpenOffice Base
Здравствуйте! Возникла загвоздка с проектированием баз данных в Base. На форме добавления данных...

Как переделать код для экспорта данных в Excel под OpenOffice Calc?
Пишу дипломную. Есть код для копирования из таблицы String Grid в программу Microsoft Excel (то...

8
4 / 4 / 0
Регистрация: 21.09.2012
Сообщений: 23
21.09.2012, 17:43 2
С VBA не дружу, лучше более детально опиши что есть, что нужно получить, будем изобретать велосипед заново.
0
0 / 0 / 0
Регистрация: 10.04.2012
Сообщений: 25
22.09.2012, 16:34  [ТС] 3
Имеется 5 файлов, одинаковых по структуре (шапка с 1 по 4 строку), данные начинаются с 5 строчки.
В каждом файле во 2 столбце стоит номер(уникальные). Все файлы необходимо собрать в 1 общий.
В каждом отдельном файле мы оцениваем по определенному критерию. в в общем файле получаем информацию по всем критериям, то есть каждому файлу соответствует собственная колонка.
В файлах могут быть одинаковые люди, а может что человека нет в каком то файле. в общем если нет его в общем списке, то добавляем и балл выставляем в соответствующую колонку, если есть, то просто балл ставим в колонку, а потом считаем для каждого количество баллов и сколько раз их выставили.
То есть отдельный файл:

1 2 3 4
№ Уникальный номер Возраст Оценка
________________________________________________

Общий файл

1 2 3 4 5 ... 6
№ Уникальный номер Возраст оценка в 1 файле оценка во 2 файле оценка в 9 файле

1 12345 20 1 9
2 12346 34 2

Ну и в итоге с 4 по 9 складываются
0
4 / 4 / 0
Регистрация: 21.09.2012
Сообщений: 23
24.09.2012, 09:37 4
Вот примерный набросок макроса, с нумерацией заморачиваться не стал, как и с подсчётом суммы баллов, но оценки из разных листов в один перетягивает по уникальному номеру. Если в новом листе встречается новый уникальный номер, то он добавляет его в составной, если же номера совпадают, то добавляет в соответствующую колонку его баллы. Макрос внедрён в документ MainFile.ods, также для демонстрационного запуска добавил на новую панель кнопку Main. Для работы макроса необходимо извлечь все файлы по пути "D:\ALDOC\Script\OOOBasic\Radistka_cat\", т.к. я его в макросе прописал. Надеюсь у вас Windows, если Linux, то можете сами путь изменить. Для запуска макроса в настройках необходимо снизить уровень запуска внедрённых макросов до среднего, чтобы выдавался запрос. Перетягивает данные из файлов File1, File2, ... , File9.
0
Вложения
Тип файла: zip File1.zip (72.4 Кб, 74 просмотров)
0 / 0 / 0
Регистрация: 10.04.2012
Сообщений: 25
24.09.2012, 23:48  [ТС] 5
Cпасибо Вам огромное, вы меня очень выручили!!!

Добавлено через 3 часа 10 минут
как то непонятно, вроде описано, то что надо как то не так.
ваот получается что он всем баллы ставит, которых и в файле нет. а не должен.
в открываемом файле баллы у всех людей стоят одинаковые(в первом файле 1, во 2- 2 и т.д.).
и если в первом человек есть, а во втором нет, то в колонке 2 файла должно быть пусто, а тут какое то значение...
номер|таб. номер|фамилия|возраст|1 ф|2 ф|3 ф |5 ф |6 ф|7 ф |8 ф |9 ф |
|1| 123| Иванов| 20| 1| |3| ||6||||
|1|123|Петров|20||2|3||||7|||
|1|123|Сидоров|20||||4|||7||9|
0
4 / 4 / 0
Регистрация: 21.09.2012
Сообщений: 23
26.09.2012, 20:38 6
Да, правда, в той версии что то я вообще напутал. Но концепция изменилась. Вот второй вариант, не на скорую руку, проверял, вроде, всё правильно.
0
Вложения
Тип файла: zip File1_v2.zip (83.2 Кб, 90 просмотров)
0 / 0 / 0
Регистрация: 10.04.2012
Сообщений: 25
26.09.2012, 21:20  [ТС] 7
так. а вот там строка, гед прописан путь к файлу д.б. File1 написано, не название общего файла. и подскажите пожалуйста ещё, в каком месте кода определяется сколько колонок переносить и начиная с какой по какую

Добавлено через 16 минут
Код
redim preserve A(l+1,ubound(A(),2))
после того как поменяла путь, на этой строчке выходит ошибка
0
4 / 4 / 0
Регистрация: 21.09.2012
Сообщений: 23
27.09.2012, 20:51 8
Что такое д.6? И какой код ошибки или её сообщение?
0
0 / 0 / 0
Регистрация: 10.04.2012
Сообщений: 25
27.09.2012, 21:10  [ТС] 9
д.б. - должно быть.
так там название первого файла указывается или общего?
Ошибка времени выполнения Basic. Переменная типа Object Не установлена.
на строчке: "redim preserve A(l+1,ubound(A(),2))".
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
27.09.2012, 21:10

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Макрос для переноса данных из одного Excel в другой Excel файл
Уважаемые эксперты, очень нужна ваша помощь! Подскажите, пожалуйста, как прописать макрос, который...

Макрос для экспорта из excel файла в excel файл шаблон
здравствуйте. подскажите как написать макрос. есть 1 файл со столбиками : город , дом, квартира,...

Макрос для загрузки картинок - работал в Excel 2013, но не работает в Excel 2016
Добрый день! Имеется макрос который работал в Excel 2013, но не работает в Excel 2016. ...

Переписать макрос с VBA на OpenOffice Basic
Есть код макроса, написанный на VBA Sub Макрос1() Dim rn As Range, r&amp;, rr&amp; Set rn =...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.