» Excel VBA (часть 3)

alin

Цитата:

Пробовал, проблема в том что неизвестно сколько строк и столбцов в каждой проверяемой книге.

Попробуйте следующее:

Код: NumberOfRows = Range("A1").End(xlDown).Row
NumberOfColumns = Range("A1").End(xlToRight).Column

AKazak
Спасибо!

asbo
Да, это круть!
Грааль пока обходится без аренды серверов .

AKazak
Спасибо!

Solenaja
SAS888

Цитата:

If Cells(k, 2) <> "" Then s = s & Cells(k, 2) & Chr(10)

Для последующей вставки содержимого объединённой ячейки в текстовый процессор, например Word, рекомендуется вместо Chr(10) использовать следующие константы:

Constant Equivalent Description

AKazak

Цитата:

в какие ещё миры проник Microsoft

Для обратной совместимости, имо. Под ДОСом с матричными принтерами FF часто приходилось использовать. VT - из той же серии. ESC/P

Задача, собственно, стояла под Access - отображать миллисекунды. В Екселе можно использовать формат "hh:mm:ss.000", но в Аксе такой номер не канает.

Поэтому в Екселе и писал, чтобы проверять правильность. Получившаяся ф-ция, понятно, универсальная для VBA. Она делает две вещи одно из двух:

- Добавляет к пользовательскому формату миллисекунды
или
- Просто отдает число миллисекунд.

Вот [more=код:]

Код: Public Function fn_FormatMs(pDate#, Optional pFormat$ = "") As Variant
Dim dDate#
Dim iMs%
dDate = CDbl(CDate(CStr(CDate(pDate))))
iMs = Round(86400000 * (pDate - dDate))
If iMs < 0 Then
dDate = dDate - 1 / 86400
iMs = iMs + 1000
End If
Select Case Len(pFormat) = 0
Case True: fn_FormatMs = iMs
Case False: fn_FormatMs = Format(dDate, pFormat) & "." & Format(iMs, "000")
End Select
End Function

Есть прайс http://norland.ru/upload/price/price-formoza.zip но он не удобный из-за того что приходиться очень долго искать нужный товар. Хочется каким то образом взять все заголовки где нету кода к примеру из А10 APPLE из А112 KOMПЛЕКТУЮЩИЕ ДЛЯ КОМПЬЮТЕРОВ и чтобы они отображались вместе и при нажатии на нужное наименование переходил к нему. Тоесть группа то что написано жирным шрифтом на сером фоне и подгруппа то что не жирным шрифтом и на более сером фоне. И так все наименования, чтобы они рядышком отображались и при нажатии на что нужно уже переходило на тот товар.

gold_boy
Посмотрите, это то что вы хотите:

Здравствуйте.

Дан файл Excel, с тремя столбцами:
NAME, DESCRIPTION, DATE.
Есть следующая задача для скрипта:
На каждую строку таблицы создать свой файл с названием NAME (из первого столбца).
В теле файла следующая конструкция:


Код: <FileImport>
<Roll>
<Field name="name" value="NAME"></Field>
<Field name="description" value="DESCRIPTION"></Field>
<Field name="date" value="DATE"></Field>
</Roll>
</FileImport>

alexxdEM0n1
Я б такое на AutoHotkey бы сделал. Но думаю и тут возможно.

* Дан файл Excel
- версия? (если парсить не открывая)

* задача для скрипта
- какого? внешнего? или VBA в имеющемся файле со списком?

* создать свой файл с названием
- с именем... какого типа? просто пустой? книгу Ексель? "свой" ???

* В теле файла следующая конструкция
- тело какого файла имеется ввиду? Который "дан", который "создать" или еще какой-то?

* value= должны браться из файла источника
- еще один файл.... а этот откуда взялся?

Сформулируй задачу по-яснее, плз ...

Цитата:

* Дан файл Excel
- версия? (если парсить не открывая)

* задача для скрипта
- какого? внешнего? или VBA в имеющемся файле со списком?

* создать свой файл с названием
- с именем... какого типа? просто пустой? книгу Ексель? "свой" ???

* В теле файла следующая конструкция
- тело какого файла имеется ввиду? Который "дан", который "создать" или еще какой-то?

* value= должны браться из файла источника
- еще один файл.... а этот откуда взялся?

Хм..
1) Версия Excel - 2003. В принципе, это вообще может быть .csv, если для внешнего скрипта.
2) Любого.
3) Первый файл с именем, получаемым из содержимого первой ячейки, второй - из второй.
Тип файла - XML.
4) Тело создаваемого файла, конечно.
5) Файл источника - это и есть файл Excel (или .csv) с которым работаем.

Давай все-таки определимся по скрипту.
Если VBA (будет читать сам себя) - то это одно.
Если внешний (VBScript к примеру) будет читать csv, то несколько по другому.
А если внешний скрипт будет читать xls - сложнее (в части разбора), надо формат знать.

Если говорить о первом варианте, то все достаточно просто:
Подключить Microsoft Scripting Runtime. Циклом по всем строкам считать значения полей в массив, а из массива, циклом по нему, через Scripting.FileSystemObject насоздавать файлов с указанным содержимым:

Set fso_Log = CreateObject("Scripting.FileSystemObject")
Set str_Log = fso_Log.OpenTextFile(sStr(1), ForWriting, True)
sXml = [... сформировать строку...]
str_Log.WriteLine(sXml)

Как-то так...

Цитата:

alexxdEM0n1
Я б такое на AutoHotkey бы сделал. Но думаю и тут возможно.

Уложился в 4-5 команд:
1. Активация файла "Книга1"
2. Переход на первую строку
3. Копирование и присваивание значений
4. Запись в файл.
Т.к. тема не соответствует, код не привожу.

Цитата:

Я б такое на AutoHotkey бы сделал

Это не наш метод :)

asbo

Цитата:

Set fso_Log = CreateObject("Scripting.FileSystemObject")
Set str_Log = fso_Log.OpenTextFile(sStr(1), ForWriting, True)
sXml = [... сформировать строку...]
str_Log.WriteLine(sXml)

С XML правильнее через MSXML работать. Да, строчек выйдет больше, но тем не менее. (Другое дело, что эта конкретная конструкция на xml-документ не больно-то и похожа, по-моему -- все эти Field'ы явно заведены только под хранение атрибутов, которые можно вполне и в Roll'е сохранить.)

[more=Через DOMDocument, например, можно сделать что-то такое...]
Код: Dim newDoc As DOMDocument: Set newDoc = New DOMDocument
Dim FileImportNode As IXMLDOMNode
Dim RollNode As IXMLDOMNode
Dim FieldNode As IXMLDOMNode
Dim AttributeNode As IXMLDOMAttribute

Set FileImportNode = newDoc.createNode(NODE_ELEMENT, "FileImport", vbNullString)
Set RollNode = newDoc.createNode(NODE_ELEMENT, "Roll", vbNullString)

Set FieldNode = newDoc.createNode(NODE_ELEMENT, "Field", vbNullString)
Set AttributeNode = newDoc.createAttribute("name")
AttributeNode.Value = "NAME"
FieldNode.Attributes.setNamedItem AttributeNode
RollNode.appendChild FieldNode

Set FieldNode = newDoc.createNode(NODE_ELEMENT, "Field", vbNullString)
Set AttributeNode = newDoc.createNode(NODE_ATTRIBUTE, "description", "")
AttributeNode.Value = "DESCRIPTION"
FieldNode.Attributes.setNamedItem AttributeNode
RollNode.appendChild FieldNode

Set FieldNode = newDoc.createNode(NODE_ELEMENT, "Field", vbNullString)
Set AttributeNode = newDoc.createNode(NODE_ATTRIBUTE, "date", "")
AttributeNode.Value = "DATE"
FieldNode.Attributes.setNamedItem AttributeNode
RollNode.appendChild FieldNode

FileImportNode.appendChild RollNode
newDoc.appendChild FileImportNode
newDoc.save "куда-нибудь"

Legio

Цитата:

С XML правильнее через MSXML работать.

Дык, ясен перец... Но только я его не трогал ни разу.
Да и я только предположил, что это XML - чтобы переменную обозвать :)

alexxdEM0n1
Если вот этот вопрос имеет к тебе какое-то отношение, то взгляни на решение, плз.

asbo
Огромное спасибо!
Это то что нужно, проверил на Вашем примере, сейчас займусь обработкой рабочих файлов.

alin
Вот и славненько. Только бэкап, бэкап и еще раз... Защита там минимальная, да и интерфейс выбора папок не интуитивен - я было заморочился с папками по умолчанию, но только запутал бы пользователя. На коленке собиралось :)

asbo

Цитата:

Дык, ясен перец... Но только я его не трогал ни разу.
Да и я только предположил, что это XML - чтобы переменную обозвать

Что это xml написал alexxdEM0n1.
А как показала та половина раза, когда мне понадобилось возиться с xml -- если в документе больше нескольких строчек и/или если требования могут измениться, лучше пользоваться стандартными средствами. (Хотя в данном случае, как мне кажется, xml используется просто чтоб былО.)

Цитата:

... лучше пользоваться стандартными средствами.

Совточно. Но у меня даже повода ни разу не было :) Как-то всегда альтернативный формат предлагался... Не изучать же этот XML исредства обработки ради него самого, чтоб булО :)

asbo
Нет, не мой вопрос.
В первой части задачи да, похоже.
Кстати, на архиве решение - пароль. Туплю?

Здравствуйте

Задача такая - нужно чтобы данные из таблицы Excel переносились в требование-накладную 1С8.1 через ком подключение

Private Sub CommandButton2_Click()
Dim ComConnect As Object
Dim Basa As Object
Dim Element As Object
Set ComConnect = CreateObject("v81.COMConnector")
Set Basa = ComConnect.Connect("Srvr=192.168.0.5;Ref=Start_UPP1;Usr =""#########"";Pwd=""#########""")
Set Element = Basa.Документы.ТребованиеНакладная.СоздатьДокумент()
Element.Дата = ДатаДокумента
Element.Записать
End Sub

Протестировал на справочниках, они заполняются нормально. Но вот если заполняю требование-накладную то строчка Element.Записать не срабатывает(не создается документ)
Подскажите пожалуйста что я делаю не так, может есть какие-то обязательные поля?
Если есть пример заполнения документа требование-накладная через Excel дайте пожалуйста ссылку очень нужно.

alexxdEM0n1

Цитата:

Кстати, на архиве решение - пароль. Туплю?

Немного :) Пароль стандартный. В личку послал.

Добавлено:
Klaxonio
Откуда уверенность, что это Ексель виноват?
По 1С есть тема соответствующая. Тема жирная. Но там тоже телепатов нет. Отпиши им код ошибки, расшифруй "Записать не срабатывает(не создается документ)" с симптомами.

Проблему решил, теперь документ создается(неправильно вводил дату)
Теперь другая проблема не заполняются другие поля документа и не выдаёт никаких ошибок.

Цитата:

asbo
Откуда уверенность, что это Ексель виноват?
По 1С есть тема соответствующая. Тема жирная. Но там тоже телепатов нет. Отпиши им код ошибки, расшифруй "Записать не срабатывает(не создается документ)" с симптомами.

Я и не говорю что Excel виноват, а вот что

Цитата:

Подскажите пожалуйста что я делаю не так, может есть какие-то обязательные поля?
Если есть пример заполнения документа требование-накладная через Excel дайте пожалуйста ссылку очень нужно.

Klaxonio

Цитата:

Я и не говорю что Excel виноват

Странный товарищ... А нафига тогда в теме по VBA Excel этот вопрос, если Ексель тут ни при чем?

Помогите товарищу, плз, если есть желание-возможность. А то я его случайно в ветку Access направил :)

Цитата:

Приветствую !

Подскажите, пожалуйста, как решить такую задачку

Есть 4 столбца

"A - название товара",
"B - количество",
"C - название товара",
"D - цена"

Массив С - содержит всю база названий товаров с их ценами (D)

Массив A - только товары, проданные за неделю и их количество (B)

Массив А является подмножеством массива С.

Нужно по этим данным создать 3 столбца (E и F и G):

E - содержит массив A
F - содержит B
G - содержит D

В VBA не силен, к сожалению.

Цитата:

Подскажите, пожалуйста, как решить такую задачку

Пример бы... А так не понятно, увы

Доброго времени суток.
Создал тему, но меня сюда направили...
Необходимо запустить весьма простой, но при этом видимо тяжелый цикл в Excel для обработки большого колличества строк. Общее число строк примерно 1 000 000, но мы уже разбили их по листам, в каждом листе 30000 - 30001 строк.

В общем сама проблема с циклом:
Цикл не проверяет все имеющиеся строки на листе. Складывается ощущение что существует какое то ограничение. Хотя тесты показали, что цикл свободно осиливает 150000 интераций (если не правильно слово написал, не сердчайте).

Цикл обрабатывает две строки по определенным столцам. Если они совпадают, он их копирует в другую книгу и удаляет. Если нет, идет на следующую строку.

Dim j As Long
Dim i As Long
Dim k As Long
Dim bookName As String

'Настройка скрипта
bookName = "Уникальные.xlsx"
i = Workbooks(bookName).Sheets(1).UsedRange.Row + Workbooks(bookName).Sheets(1).UsedRange.Rows.Count
j = 1

' Сам цикл

Do While Not ActiveWorkbook.Worksheets(1).Cells(j, 5).Value = Empty

'Проверка двух строк
If (Cells(j, 5).Value = Cells(j + 1, 5).Value) And _
(Cells(j, 6).Value = Cells(j + 1, 6).Value) And _
(Cells(j, 7).Value = Cells(j + 1, 7).Value) And _
(Cells(j, 8).Value = Cells(j + 1, 8).Value) Then

ActiveWorkbook.ActiveSheet.Rows(j).Copy Destination:=Workbooks(bookName).Sheets(1).Rows(i)
ActiveWorkbook.ActiveSheet.Rows(j+1).Copy Destination:=Workbooks(bookName).Sheets(1).Rows(i+1)
Rows(j+1).Delete
Rows(j).Delete
i = i + 2

'Уникальную строку пропускаем

Else

j = j + 1

End If

Loop

Первый раз писал скрипт не я, так что скорее всего в этот раз буду использовать Do Untile.

Цикл не хочет проверять все строки. Выполняется около 10000 раз. Копирует из книги нужные строки но не по всей книге. Возможно проверку окончания цикла не правильно сформулировали? 5 столбец не может быть пуст, это фамилия.

Quieteroks
Могу предложить вариант, который будет работать в десятки (сотни) раз быстрее, при условии, что будет пример исходного файла. Не обязательно такого большого, достаточно несколько строк.