» Excel VBA (часть 3)

AndVGri
Спасибо за подсказку и пример. Кажется, идея с классами - это то, что надо. Буду пробовать.

AndVGri
Сказано ведь классиками - не плодите сущностей без нужды.
Практический-то смысл этой конструкции (160 копий класса загнать в коллекцию) какой?

Не учтено, что:
1. Задействованы еще несколько типов контролов
2. Несколько контролов исключены из процедуры сравнения

kandi
1. Безотносительно к реализации - пользователь не очумеет от 160-ти диалогов?
2. По п.2 выше - надо определиться - будут ли эти контролы считаться по умолчанию измененными или нет? Это не для мессаджей, а для логики добавления (изменения) записи.

Предполагается, что читать - писать и устанавливать соответствия между ячейками и контролами уже [more=умеем]

Option Explicit

Private rRngOld As Range, rRngNew As Range
Private lEx&(1 To 2)
Private bDirtyR As Boolean

Sub Form_Ini()
set rRngOld = Range("A1:FD1") ' source data for form row 1
set rRngNew = Range("A111:FD111") ' temporary range on row 111
If rRngOld.Cells.Count <> rRngNew.Cells.Count Then Stop

lEx(1) = 5 ' cells excluded from comparing
lEx(2) = 9 '
End Sub

Sub sb_Compare()
Dim i&
Dim bDirtyC As Boolean
For i = 1 To rRngNew.Cells.Count
Select Case i
Case lExcl(1), lExcl(2)
bDirtyC = ??? ' see p.2
' do nothing
Case Else
bDirtyC = (rRngOld.Cells(i).Value <> rRngNew.Cells(i).Value)
If bDirtyC Then Call sb_Msg ' call message procedure
bDirtyR = bDirtyR Or bDirtyC
End Select
Next
If bDirtyR Then Call sb_RecNew ' add new or edit existed record
rRngNew.Clear
End Sub
[/more]

grbdv


Цитата:

1. Безотносительно к реализации - пользователь не очумеет от 160-ти диалогов?

А куда им деваться? Это не моя блажь, так требуют (бюджетная организация).


Цитата:

По п.2 выше - надо определиться

эти контролы чисто информационные: номер текущей записи и общее число записей, в базе данных они не присутствуют и не учитываются. Надо было сразу сделать их как "Label", а не "TextBox". Будем, для упрощения, считать, что их нет.
Кстати, а можно как-то прикрепить файл к сообщению, чтобы разговор был предметным?

kandi
1. Понятно, что их не все 160 будет, но все равно - утомит... Разве что, при первоначальном вводе данных - но это можно или опытным юзерам прямо в Ексель поручить вколачивать, или же предусмотреть отключение диалогов.

2. А я все-таки не понял методу - будет добавляться новая запись на базе существующей или же редактироваться существующая? Или и то, и другое может быть?

Файл не прикрепляется. Надо выкладывать на rghost.net, к примеру, а сюда ссылку. Картинки тоже надо выкладывать на хостинг, а здесь показывать вот таким кодом:
[no] [/no]
Пример (весь код можно посмотреть нажав на "Редактиовать"):

grbdv
Существующая запись может только редактироваться. Новая запись создается с нуля - заполняется ответственным сотрудником со слов (или анкеты) посетителя.
Вот сама карточка:
Ссылка

kandi

Цитата:

Существующая запись может только редактироваться. Новая запись создается с нуля - заполняется ответственным сотрудником со слов (или анкеты) посетителя.

Ага. Понял. Это уже лучше.
Файл скачал, чуть позже посмотрю.
См. личку

Добавлено:
grbdv
Что ж, добротно сделано.
На первый взгляд решается просто. Пока в общем опишу, думаю идея будет понятна.

Массив Data заполняется в LoadRecord() непосредственно из Range (это не есть хорошо, об этом ниже-позже). Он же Data используется для хранения промежуточных данных в PreSaveRecord(). Если в лоб - то надо просто завести еще один массив DataSave, после заполнения Data переразмерить по нему DataSave и использовать в PreSaveRecord() именно его. А потом циклом сравнить друг с другом по второму измерению. И фсе. Или я чего-то не увидел...

Добавлено:
Задача исключительно под Access.
Буду в каждом сообщении писать :) Все бОльшим и бОльшим шрифтом :)

Пробовал. Вылазит непонятная вещь. Даже если не делать никаких изменений - показывает расхождения в массивах. Проще переделать на сравнение двух временных диапазонов на дополнительном листе (сейчас как раз пробую). Пока получается.

Dim DataSave As Variant

Sub LoadRecord()
'....
Data = RangeData.Value
DataSave = RangeData.Value
Redim DataSave(LBound(Data, 1) to UBound(Data, 1), LBound(Data, 2) to UBound(Data, 2))
'....
End Sub

Добавлено:

Цитата:

Даже если не делать никаких изменений - показывает расхождения в массивах.

Дык... DataSave пустой.
Надо тогда - см. выше зачеркнутое.

Делал специально контрольный MsgBox с сообщением о сравниваемых полях. При переходе от записи к записи, без всяких изменений отображались каждый раз разные пары полей с "отличиями", причем реальных отличий, по крайней мере видимых, нет. Выяснять причину не стал, убрал массивы и перешел на сравнение на листе.

kandi

Цитата:

При переходе от записи к записи, без всяких изменений отображались каждый раз разные пары полей с "отличиями",

Я не понял тогда, где ты проверку ставишь? См. пример ниже.

А вобщем, это из-за того, что ячейки с текстовыми данными отформатированы, как числа. При передаче в форму из Data() эти числа неявно преобразовываются в текст, а обратно в DataSave() передаются, как текст, без преобразования. Ведь и Data, и DataSave - Variant. Они схавают все, что дадут: мякину заложишь - мякину получишь. Надо все ячейки отформатировать как текст! И при добавлении новых строк не забывать об этом

С учетом изменений в моем посте выше - вот процедура проверки[more=вариант:]

Код:
Private Sub SaveRecord()
Call PreSaveRecord
Call sb_CheckDiff ' + by grbdv
Stop ' add by grbdv
' Assign Data array values to current record in mainBase
RangeData.Value = Data
End Sub
Private Sub sb_CheckDiff() ' + by grbdv
Dim i%
For i = LBound(Data, 2) To UBound(Data, 2)
If Data(1, i) <> DataSave(1, i) Then
Debug.Print "Step " & i & vbLf & Data(1, i) & vbLf & DataSave(1, i) & vbLf
'Stop
End If
Next
End Sub

Private Sub PreSaveRecord()
' Copy values from Personal controls to DataSave array
' Мати
DataSave(1, 1) = TextBox_mam_FIO.Value ' * by grbdv All Data( -- > DataSave(
DataSave(1, 2) = TextBox_mam_Rojd.Value
...
End Sub

grbdv
Сиречь о Вашем коде. Сравнение ячеек на листе - не лишняя сущность (скорость только маловата будет)?
Можно и массивами обойтись - если религия не позволяет. Приведённый мной код - пример, требующий конечно детализации, только ТУ автором не заявлено.
Цитата:

2. Несколько контролов исключены из процедуры сравнения

А что есть проблема с недобавлением в коллекцию, например по именам?

AndVGri

Цитата:

Сиречь о Вашем коде. Сравнение ячеек на листе - не лишняя сущность (скорость только маловата будет)?

Нет. Не лишняя. А, наоборот даже, уже существующая. Изначально данные в строке хранились, в строку же возвращались. Поэтому использование строки для промежуточного хранения вполне естественно, не противоречит общей идеологии и не надстраивает уже имеющуюся конструкцию объектом уникальной природы.

И даже, если бы лишняя - это что, делает применение класса более обоснованным? Я не гордый, второй раз спрошу - какой практический-то смысл этой конструкции? Может я чего-то и не углядел...


Цитата:

Можно и массивами обойтись - если религия не позволяет. Приведённый мной код - пример, требующий конечно детализации, только ТУ автором не заявлено.

Причем тут религия? Позволяет, не позволяет... Не надо передергивать - мое решение через служебную строку возникло до твоего класса, и до засветки примера. И лишь потом я предложил дополнительный массив, забыв про строку. И не надо себе льстить - отнюдь не в противовес классу (лишь бы что-то другое), а исключительно из - см. абзац выше, заменив понятие "строка" на "массив".

И что значит обойтись? Массивами я не обходился - решение с ними возникло позже, - после знакомства с кодом, алгоритмом и квалификацией автора. А до знакомства, будучи еще не в курсе, я предложил вариант, основанный на механизмах, которые, теоретически, должны были бы уже быть реализованы. Применительно к массивам, кстати, это тоже справедливо.

И хочу напомнить, что на тот момент и у меня не было ни ТЗ, ни образца проекта.

И хоть я уже отказался от него, решение через строку, кстати, сразу заработало. А сколько пришлось бы класс с коллекцией встраивать в проект, а?


Цитата:

А что есть проблема с недобавлением в коллекцию, например по именам?

Я что-то не пойму, что это я распинаюсь-оправдываюсь изо всех сил? Оттянусь, пожалуй, малехо :) Сам [more=напросился...]

Цитата:

А что есть проблема с недобавлением в коллекцию, например по именам?

А что нету? Вначале разберись с типами контролов и уточни свою идею и код под них. Сразу к именам :)

Я, кстати, в своем посте заметил, что "не принято во внимание использование нескольких типов контролов" - осталось бэз ответа...

Там же я, кроме сентенции о сущностях, еще задал вопрос: "Какой практический-то смысл этой конструкции?" - тоже бэз ответа...

Нет проблем - так и говори. Есть - опиши. Да и начинать лучше с ответа на заданные вопросы. А то выбрал для поста самое удобное (больное?) для себя.

Бзв, сиречь == то есть, иначе/точнее говоря, (а) именно, то есть, то бишь, словом. С рус.яз. проблемы?

К чему все эти тролло-вопросики? Религия... проблемы... В лучшем стиле ведем диалог :)
В _такой_ манере будем общаться, да? Я, конечно, могу... Но не с руки мне - догадайся с двух раз, кто вперед к бану прибежит, 621@2005 или 45@2011?


Ну да ладно... Что лаяться из-за этого? В конечном итоге всегда одно из решений будет лучше другого. Если не абсолютно, но в каком-то разрезе - определенно.

Если так, то - вернемся к нашим баранам :)
[/more]
Итак (сиречь :), если ты не видишь проблем с исключением некоторых контролов из проверки по имени, значит не видишь их и в передаче значений как в контролы, так и обратно.

Имена контролов ужЕ используются минимум в двух местах в коде. Ты предлагаешь еще и третий раз это сделать (см. про "не плодите..."). А потом по всему коду сбиться с ног, искать в случае изменений? Чую, щаз речь зайдет про эффективные методы поиска-замены в редакторе и навыки использования регэкспов :)

Я позже хотел обратить внимание kandi на эту проблему, чтобы не сбиваться с курса. Придется сделать сейчас.

Применительно к примеру, я бы создал служебную таблицу соответствия полей контролам. Что-то типа:
Cell_Column, Control_Name, Control_Type, Check_Exclude_Flag
еще какую-нибудь хрень можно в нее загнать...

Потом занес бы соответствующий индекс в св-ва каждого контрола. Например в св-во .Tag. И/или к имени можно добавить суффикс/префикс. Вобщем, место есть для фантазии.

Далее, при загрузке формы проверял бы все контролы с .Tag <> 0 на соответствие .Type и .Name данным в таблице соответствия. Тогда любые несинхронизированные изменения в структуре таблицы, формы или в коде сразу вылезут. Далее этот индекс можно использовать в циклах загрузки данных в форму и выгрузки обратно. Тем самым окультурим и разгрузим процедуры LoadRecord() и PreSaveRecord(). Да и защита от дурака некая появится на этом скользком участке.

Доброго времени суток!

Задача вроде бы простая, чую что сие возможно сделать в Word/Excel но не знаю как (по макросам у меня 6-ой разряд домашний =) ).


Есть список слов или словосочетаний в текстовом файле по одному в каждой строчке:

слово1
слово сочетание2
слово3
слово4
слово сочетание5

и т.д. (30 строк)

нужно из этих данных сгенерировать наборы слов/словосочетаний чтобы получилось по 3-6 слов в строку через запятую с рандомной выборкой:

слово1, слово3, слово сочетание5
слово4, слово10, слово7, слово сочетание4, слово8, слово12
слово2, слово14, слово сочетание6, слово сочетание9, слово5
слово сочетание6, слово сочетание7, слово8, слово сочетание11

и т.д. (200-300 строк)


Готов отблагодарить электроденьгами =)

grbdv
Ой. Ну извините коли так, обидеть не хотел, может излишен ёрничал. Дело хозяйское (в xml листа со служебной таблицей до записи в него данных - что-нибудь там существует?) - кто чего хочет, кто как умеет. Суть не меняется.
Fader
Не совсем понятно. Каждое слово или фраза могут выведены в строках результата только раз (допустим слово4 может появиться в 6 строке и больше ни в каких строках быть не может)? Тогда 200-300 строк не будет. Или разговор идёт об уникальных сочетаниях по 3-6 слов/фраз?

Добавлено:
grbdv
1. Все Controls на форме статические - значит имена есть. Автор вопроса не утверждал, что они добавляются в процессе работы программы.
Кто ж мешает использовать просто Control (я писал пример и не более). Соответственно предыдущее значение можно хранить в Variant.
Класс удобнее для организации обработки событий от, назовём класс диспетчер смены записей, ПользователюДанаЗапись, ПроверитьЗаписьНаИзменение. Следовательно нет циклов. Всё компактно в двух модулях классов. Скорость с событиями меньше конечно, но удобства больше.
Да и стоит ли копья ломать из-за процедурного или ООП подхода к решению задачи?

AndVGri
Да все нормально. Рабочий момент :) Главное - клиента не запутать. От простого (и уже имеющегося) - к сложному и новому :)

Fader
Если я правильно понял, то разницы нет - "слово" или "словосочетание", т.к. "словосочетание" обрабатывается как единый элемент без анализа его содержимого. Так?

Если так, то задача будет формулироваться:
Из имеющихся в текстовом файле строк сформировать список из 200-300 строк (выбираемых случайным образом?), в каждой из которых должно быть от 3 до 6 исходных строк (выбираемых случайным образом?), разделенных запятой и выбираемых из исходного списка случайным образом. Так?

Бзв, если это для вебстроительства список ключевых слов генерируется, то может имеет смысл поискать существующие генераторы...





Добавлено:
Fader
Вот [more=код:]

Код:
Sub sb_KeyWords()
Dim fso As FileSystemObject
Dim strR As TextStream, strW As TextStream
Dim i%, j%, k%, iQty%, iW_Lines%(3), iW_Words%(3), iFormat%
Dim sPath$, sFileR$, sFileW$, sDlm$, sSfx$, sExt$, sSrc$(), sTgt$

' USER DATA SETUP
iW_Lines(1) = 20: iW_Lines(2) = 30 ' Low & Upper bounds of lines in target file
iW_Words(1) = 3: iW_Words(2) = 6 ' Low & Upper bounds of elements in line

sPath = "C:\Path1\Path2\Path3" ' type real path here w/o ending slash
sFileR = "TextPhrases" ' Name of sourse file
sSfx = "Rnd" ' Suffix of target file
sExt = "txt" ' A same extension for both of files
sDlm = "," ' Delimiter

iFormat = TristateUseDefault ' -2 - Opens the file using the system default
' iFormat = TristateMixed ' -2 - Opens the file using the system default
' iFormat = TristateTrue ' -1 - Opens the file as Unicode
' iFormat = TristateFalse ' 0 - Opens the file as ASCII

' PROCEDURE
sFileW = sFileR & "_" & sSfx
sFileR = sPath & "\" & sFileR & "." & sExt
sFileW = sPath & "\" & sFileW & "." & sExt

Set fso = CreateObject("Scripting.FileSystemObject")

With fso
Set strR = .OpenTextFile(sFileR, ForReading, , iFormat)
With strR
Do While Not .AtEndOfStream
iQty = iQty + 1
ReDim Preserve sSrc(1 To iQty)
sSrc(iQty) = .ReadLine
Loop
End With

Set strW = .OpenTextFile(sFileW, ForWriting, True, iFormat)

Randomize (Timer + 1) ' (GetTickCount)
iW_Lines(0) = Int((iW_Lines(2) - iW_Lines(1) + 1) * Rnd + iW_Lines(1))
For i = 1 To iW_Lines(0)
Randomize (Timer + 2) ' (GetTickCount)
iW_Words(0) = Int((iW_Words(2) - iW_Words(1) + 1) * Rnd + iW_Words(1))
sTgt = ""
Randomize (Timer + 3) ' (GetTickCount)
For j = 1 To iW_Words(0)
k = Int((iQty - 1 + 1) * Rnd + 1)
sTgt = sTgt & sDlm & Trim(sSrc(k))
Next
sTgt = Right(sTgt, Len(sTgt) - 1)
strW.WriteLine (sTgt)
Next
End With
MsgBox "OK"
End Sub

Цитата:

Или разговор идёт об уникальных сочетаниях по 3-6 слов/фраз?

именно

grbdv
Спасибо огромное! Насколько я вижу получилось именно то что мне нужно! Сейчас попробую сгенерить из своих данных. Если все получится - жду в ЛС ваш WMR

Добавлено:

Цитата:

если это для вебстроительства список ключевых слов генерируется, то может имеет смысл поискать существующие генераторы...

как-то не находил такого...

grbdv
Толькоо для такой организации выборки вероятность получить две строки из 200 строк результата, содержащие по 6 одинаковых слов, исходя из схемы Бернулли не так уж и мала p=0.0168

Fader

Цитата:

Спасибо огромное! Насколько я вижу получилось именно то что мне нужно! Сейчас попробую сгенерить из своих данных. Если все получится - жду в ЛС ваш WMR

Полно, голубь, не греши.
Убери свои гроши.
Мы ведь, енто, не из денег.
Мы ведь, енто, для души...

Будет новая беда -
Прямиком спеши сюда.
Чай, и мы в лесу не звери,
Чай, поможем завсегда. (С)

Не за что :) Пусть хоть запашет без ошибок.
В первой части кода надо установить свои диапазоны, пути-имена и разделитель. Если разделитель нужен с пробелом, то так и написать ", ".

AndVGri

Цитата:

для такой организации выборки вероятность получить две строки из 200 строк результата, содержащие по 6 одинаковых слов, исходя из схемы Бернулли не так уж и мала p=0.0168

- В моем доме попрошу не выражаться!
- А что я сказал?.. (С)


Я, честно, об этой схеме понятия не имею :) Тервер хоть и сдавал, но за давностию лет и без нужды и практики - давно фтопке. Я краем уха слышал, что экселевский генератор псевдиков не совсем гут. Я хотел было помудрее инициатор сделать - плюнул. Конечно, можно было найти поизящней алгоритм или же библиотеку подключить. Я его слепила из того, что было :) Думаю, что для бытового утилитарного применения - сгодится.

Ребята я извиняюсь но что-то я совсем туплю... а тут еще этот оффис 2010, плотно работал с оффисом я еще когда актуальная версия была 2003. А этот интерфейс меня пугает =)

Вобщем, стыдно конечно, но мне нужен солюшен "разжевать и в рот положить". Другими словами готовый вариант: запустить нажать кнопку/хоткей и опа.

Поэтому про WMR и заговорил

А исходные данные я вроде все указал. Файл который будет парситься, пусть зовется, например, text123.txt.

Fader
WMR на двоих? grbdv если не сделает, то давай я со своей классово ненавистной версией, вкладкой и кнопкой в Excel 2010

Fader
На всякий случай - [more=инструкция:]
1. Запускаешь эксель
2. Создаешь файл.
3. Сохраняешь.
4. Alt+F11
5. ПКМ на проекте твоей книги - Insert Module
6. В этот модуль копируешь код (скопируй заново с форума - я добавил мсдж об окончании работы).
6.1 Сохранить

7. Вводишь свои данные:
sPath = "C:\Path1\Path2\Path3" - путь к папке, где файл без прямой косушки на конце;
sFileR = "TextPhrases" - имя оригинального файла без расширения;
sSfx = "Rnd" - суффикс, добавляемый к имени исходного файла, чтобы сформировать имя файла-назначения;
sExt = "txt" - расширение исходного файла; одинаковое будет у обоих;
sDlm = "," - требуемый разделитель (м.б. несколько символов, например ", ") внутри строки.

8. Сохранить все.
9. Поместить курсор куда-нибудь внутрь кода и нажать F5

Enjoy
[/more]
Если не получится, то позже я файл выброшу с кнопкой, с модифицированным кодом и инструкцией. Но это уже только завтра после обеда МСК.

grbdv
не хотит


AndVGri
подождем grbdv, я в него верю

Виноват.
Надо закрыть этот диалог. В этом же окне Tools - References, в списке найти "Microsoft Scripting Runtime", поставить на нем галку и ОК. Если не найдется в списке, то Browse... и указать ...\System32\scrrun.dll. Галку и ОК.

Добавлено:


Добавлено:
И еще [more=забыл:]
iW_Lines(1) = 20 - мин кол-во строк в файле назначения
iW_Lines(2) = 30 - max --"--
iW_Words(1) = 3 - min кол-во фраз в строке
iW_Words(2) = 6 - max --"--
[/more]

grbdv
Теперь жму F5 затем Run - во всплывающем окошке пишет ОК но таблица так и остается пустой.
Ничего не генерится... (

По введенной дате выдать ее словесное описание, ребята помогите написать, я хоть прикуривать начну. Заранее большое спасибо

NiNo52RUS
Так что там сложного? Поищи - сумма прописью - и сделай по аналогии.
[more=Для примера для дней]

Код:
Option Explicit

Private Function DayTens(ByVal Value As Integer) As String
Select Case Value
Case 2: DayTens = "двадцать "
Case 3: DayTens = "тридцать "
End Select
End Function

Private Function DayUnities(ByVal Value As Integer) As String
Select Case Value
Case 1: DayUnities = "первое"
Case 2: DayUnities = "второе"
Case 3: DayUnities = "третье"
Case 4: DayUnities = "четвёртое"
Case 5: DayUnities = "пятое"
Case 6: DayUnities = "шестое"
Case 7: DayUnities = "седьмое"
Case 8: DayUnities = "восьмое"
Case 9: DayUnities = "девятое"
Case 10: DayUnities = "десятое"
Case 11: DayUnities = "одиннадцатое"
Case 12: DayUnities = "двенадцатое"
Case 13: DayUnities = "тринадцатое"
Case 14: DayUnities = "четырнадцатое"
Case 15: DayUnities = "пятнадцатое"
Case 16: DayUnities = "шестнадцатое"
Case 17: DayUnities = "семнадцатое"
Case 18: DayUnities = "восемнадцатое"
Case 19: DayUnities = "девятнадцатое"
End Select
End Function

Public Function DayToString(ByVal forDate As Date) As String
Dim vDays As Integer
vDays = VBA.Day(forDate)
Select Case vDays
Case 1 To 19: DayToString = DayUnities(vDays)
Case 20, 30: DayToString = DayTens(vDays \ 10)
Case Else: DayToString = DayTens(vDays \ 10) & DayUnities(vDays Mod 10)
End Select
End Function

Fader

Цитата:

жму F5 затем Run ... таблица так и остается пустой...

Откуда, блин, Run взялся?... Какая, блин, таблица?!

Написано же было "9. Поместить курсор куда-нибудь внутрь кода и нажать F5 " Буквально и пошагово выполняй инструкции. Сбился - останови все. Закрой все. Открой снова. Перепроверь исходные данные. Закрой ВСЕ приложения (блокноты-макноты-браузеры), использующие эти файлы, - исходный и результирующий. Вообще удали результрующий файл - он создастся сам.

grbdv
не нервничайте, все в порядке! Закрыл Outlook и все сработало

Благодарю!

Приветствую
оптимизируйте пожалуйста код


Код: Range("AE8:AE67").Select
Selection.Copy
Range("AH8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

TXP
См. хэлп по Do, Loop, For, While. [more=Код ниже:]

Цитата:

оптимизируйте пожалуйста код

Пожалуйста:
Код: Range("AE8:AE67").Copy
Range("AH8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False