» Excel VBA (часть 3)

Здравствуйте. Возникла такая проблема. Для Microsoft Excel требуется некий макрос на VBA. Думаю требуемое пишется очень легко, но я не силён в программировании. Прошу помочь.
В общем в ячейках А1, А2, А3,А4, А5 и т.п. (максимум А10) распологаются разные рандомные числа. В ячейке B1 находится некая сумма, которая складывается из каких то сумм в ячейке (А1...А10), но из каких сумм она складывается - неизвестно. Вот это и надо выяснить! Нужно что бы программа перебором складывала разные сочетания цифр из ячеек А1-А10 до тех пор, пока их сумма не сойдётся с цифрой в ячейки B1 или до тех пор, пока не переберутся все возможные варианты. Помогите пожалуйста!

Неужели никто не подскажет?

Levitant

Попробуйте без VBA, в эксерле Сервис /подбор параметра, далее в справке.

PrWork1, не сработает, слишком много параметров на перебор. Да и как СМЕЩ() тюнить кольцевать?

ZlydenGL
Жаль, тогда остается на VBA писать...

PrWork1, не просто VBA, а рекурсивная процедура/функция. Сомневаюсь, что кто-то возьмется за написание.

ZlydenGL
Да не так уж и сложно. Я алгоритм представляю (и он не очень сложный), но писать для студента, которому влом самому разбираться/учиться, а зачет получить надо – я не буду…

Oyger, ну дык те же мысли бродят Рекурсия - она только для начального понимания сложная Алгоритм я помню даже не примерно - на какую-то олимпиаду писал похожее задание (на Паскале).

Подскажите, пожалуйста, как можно упростить и распространить действие на любое количество ячеек такой макрос записанный вручную:
[more=Макрос...]Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 22.01.2010 (Administrator)
'

'
Range("A2:C2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A3:C3").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A4:C4").Select
Selection.Sort Key1:=Range("A4"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A5:C5").Select
Selection.Sort Key1:=Range("A5"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A6:C6").Select
Selection.Sort Key1:=Range("A6"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A7:C7").Select
Selection.Sort Key1:=Range("A7"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A8:C8").Select
Selection.Sort Key1:=Range("A8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A9:C9").Select
Selection.Sort Key1:=Range("A9"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A10:C10").Select
Selection.Sort Key1:=Range("A10"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A11:C11").Select
Selection.Sort Key1:=Range("A11"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A12:C12").Select
Selection.Sort Key1:=Range("A12"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A13:C13").Select
Selection.Sort Key1:=Range("A13"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A14:C14").Select
Selection.Sort Key1:=Range("A14"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A15:C15").Select
Selection.Sort Key1:=Range("A15"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A16:C16").Select
Selection.Sort Key1:=Range("A16"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A17:C17").Select
Selection.Sort Key1:=Range("A17"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A18:C18").Select
Selection.Sort Key1:=Range("A18"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A19:C19").Select
Selection.Sort Key1:=Range("A19"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A30:C30").Select
Selection.Sort Key1:=Range("A30"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A31:C31").Select
Selection.Sort Key1:=Range("A31"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A32:C32").Select
Selection.Sort Key1:=Range("A32"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A33:C33").Select
Selection.Sort Key1:=Range("A33"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A34:C34").Select
Selection.Sort Key1:=Range("A34"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A35:C35").Select
Selection.Sort Key1:=Range("A35"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A36:C36").Select
Selection.Sort Key1:=Range("A36"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A37:C37").Select
Selection.Sort Key1:=Range("A37"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A38:C38").Select
Selection.Sort Key1:=Range("A38"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("A39:C39").Select
Selection.Sort Key1:=Range("A39"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
End Sub
[/more]

VolunKOV, например - через For Each R In ActiveSheet.Rows

Добавлено:
Или For Each R In Range(UserRange).Rows

ZlydenGL
Я пока очень плохо разбираюсь в VBA, фактически второй раз только жизнь столкнула с ним, поэтому можешь, если несложно, пример такого макроса показать?)

Житие мое... Держи Писал по памяти, поэтому дебаг если что сам делай


Код: For Each R In UserRange.Rows
Range("A" & R.Row & ":C" & R.Row).Select
Selection.Sort Key1:=Range("A" & R.Row), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Next R

ZlydenGL, спасибо большое!
Теперь дело пойдет)
А то чувствую, что страшно криво сделано, а в универе только паскаль учил)

В благодарность могу выложить макрос Excel вычисляющий контрольную 13-ю цифру по алгоритму шрих-кодирования EAN-13:
[more=EAN-13...]
Sub EAN13()
For t = 1 To Excel.Selection.Cells.Count
'редактируем введёную строку доведя её до 12 знаков нулями слева
bk = Excel.Selection.Cells(t).Value
If Len(bk) < 12 Then bk = String(12 - Len(bk), "0") & bk
bk = Left(bk, 12)
'вычисляем контрольную цифру
sy = 0
For rt = 1 To 12 'перебираем все 12 значащих цифр
sy = sy + Val(Mid(bk, rt, 1)) * (1 + 2 * ((rt + 1) Mod 2)) 'суммируем
'все цифры кода, причём каждая вторая цифра
'домножается на 3
Next rt
sy = 10 - sy Mod 10 'теперь sy равно числу, дополняющему старое
'sy до ровного десятка (это и есть контрольная цифра)
If sy = 10 Then sy = 0 'если получилось 10, то оставляем только 0
bk = bk & sy 'дописываем контрольную цифру к коду
Excel.Selection.Cells(t).Value = bk 'ставим готовый код обратно где брали
Next
End Sub
[/more]

З.Ы. Это та, первая, встреча с VBA)

Имеется таблица в Excel с формулами и вычислениями, типа /товар->кол-во->общая стоимость/, ну и внизу всего этого /скидка в процентах->общая стоимость/. Как бы сделать кнопочку экспорта или, типа, печать формы в pdf формате, ну как чек что ли. Вот такая вот задумка. Если кто знает, помогите. Спасибо.

З.Ы. Не шарю вообще в этих макросах. Если кто возьмётся, то спасибо.

З.Ы. Прочитал только что в шапке темы "топик для помощи в изучении и использовании VBA....Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)". Ребят, просто некогда заниматься изучением матчасти, вот и обращаюсь. Простите если что не так.

К предыдущему моему посту:
А если упростить немного задачу? Если известно заранее из скольки чисел складывается сумма, а вот из каких неизвестно?
Дело в том, что ВБА я не знаю вообще, в универе проходил только Паскаль и С++, а данная вещь нужна для использования на работе для себя!

vasinvan, копай в сторону .PrintOut, макрос получается в две строки. Можешь включить запись макроса и отправить лист на печать, чтобы получить примерный код.

Levitant, количество ячеек не важно, бо рекурсивной процедуре без разницы число ячеек. Если проходил паскаль и представляешь алгоритм поиска - на VBA тоже напишешь без проблем, ибо паскаль все-таки сложнее будет.

ZlydenGL
Чёто ничё не понял. Разжуй, приз.

vasinvan, подними глаза в шапку?


Цитата:

Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)

Посему, если задача интересная, то:

1. Открываем Excel
2. Жмем Alt+F11
3. Создаем новый модуль
4. Пишем в него PrintOut
5. Ставим курсор на начало слова и жмем Ctrl+F1.

Поверь, этот мир стоит того, чтобы потратить некоторое время на то, чтобы с ним подружиться

ZlydenGL, спасибо. Половина получилась, а вот в справке я запутался. Вы уж не серчайте. Ну не селён я в этом, да и времени нет.

vasinvan, на будущее - в MS Excel есть предустановленная панель Visual Basic, на которой в том числе есть кнопка "Запись" - она записывает ВСЕ действия пользователя в рамках текущего приложения в макросы, т.е. нормальный код VBA. Естественно, запись оказывается "грязной", т.е. зачастую с избыточным числом переменных и т.д., но понятие о последовательности команды эта штука дать может.

В твоем случае вызов в макросе команды

Код: ActiveSheet.PrintOut

ZlydenGL
оки-доки. Буду пробовать. Спасибо.

Доброго время суток Подскажите если кто сталкивался как загружать из Excel или txt остатки по счетам, я из Паруса 7 и Беста 3.4 выгружаю в 7.7 и 8.1 соответственно, справочники документы смог, а вот остатки по счетам не знаю с чегоначать(

Shtok, ну это ты оптимистично в эту тему зашел Тут VBA в чистом виде, а тебе нужен код 1С.

Это;) Хочешь решить задачу не туда залезешь;) Ладно сворачиваю сообщение)

Господа,
подскажите, как в Excel VBA можно переконвертить файл из формата .xml в .xlsx (формат Excel 2007).
Дело в том, что известная мне SaveAs работает, только если файл уже открыт, а я хочу чтобы допустим все файлы из директории с расширением .xml пересохранить в формат .xlsx одним кликом мыши.
Есть прога которая экспортирует в формат .xml. Каждый день по 5-6 файлов приходится открывать и пересохранять руками, чтобы потом с ними работать (еще и при открытии убирать назойливое сообщение, что файл не в том, что нужно формате). Это уже порядком достало, хочу как-то автоматизировать этот процесс.

mrdime

Не думаю что это решится VBA. Нужно писать скрипт Подробнее можно поглядеть например тут http://www.script-coding.info/MSOffice.html

mrdime
JekG

И с VBA можно, там же пример и написан:

Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.DisplayAlerts = False
ExcelApp.WorkBooks.Open "C:\TEMP\Test.txt"
ExcelApp.ActiveWorkbook.SaveAs "C:\TEMP\Test2.txt", xlTextMSDOS
ExcelApp.Quit

PrWork1

Не уверен честно говоря. Помню из XP переводил в 2003 отаким макросом http://www.codeproject.com/KB/vbscript/xls2xml.aspx
Сильно мудреный перевод выходит. Чем не проще поставить ФайлФорматКонвертер от Майкрософта и не забыть о несовместимости форматов?

PrWork1
JekG
Дело в том, что при открытии файла каждый раз вылазит назойливое сообщение типа:
"Файл, который вы пытаетесь открыть в другом формате, чем указано в расширении. Проверьте, получен ли файл из надежного (доверенного) источника перед тем как откыть файл. Хотите открыть файл сейчас?" И набор кнопенций: да, нет, помощь.
У меня Офис английский, потому данное сообщение привожу в переводе. В русской версии может звучать немного по-другому.
Дело в том, что прога, из которой экспортируется информация, экспортирует данные в формате .xml, но физически файлу присваивается расширение .xls. (так вот криво реализовали разработчики).
Т.е. если подобные файлы будут открываться перед сохранением через Open, надо решить каким образом убрать это сообщение.
JekG

Цитата:

поставить ФайлФорматКонвертер от Майкрософта

Можно подробнее: как его програмно вызывать и работать с ним из VBA либо используя Windows Scripting.

mrdime, так может быть просто батник создать, чтобы он разом все .xml переименовывал в .xls?