» Excel VBA (часть 3)

vasiliy74
Не много ли With --- End With?
Попробуй
Const xlDown = -4121
Const xlToRight = -4161
Dim Range

Set Range = MySheet..Range(MySheet.Cells(1, 1), MySheet.Cells(1, 1).End(xlDown).End(xlToRight))
Range.Font.Size=22

всем привет, у меня такая проблема: пытаюсь написать макрос... нечто в стиле брутфорса...
вобщем есть табличка с данными, в ней 20-30 столбцов, и есть автофильтр, нужно перебрать все возможные комбинации фильтровки этих столбцов по заданному условию с целью получения максимальной суммы в последнем столбце, где стоят 1 и 0 например:

столбец 1 2 3 4 5 | 6
___________________________________________________________
а в с м а |0
в с с р s |1
c b c s p |1

где a,b,c...-это условия по которым я буду фильтровать (с этим я разобрался)
и вот теперь мне надо отфильтровать 1 и второй стобец (как сравнивать результаты я тоже разберусь) потом первый и третий и т.д.
потом попробовать три столбца вместе... вобщем перебрать все возможные варианты, в поисках оптимального... брутфорс вобщем нужен...

FEGORA
30 столбцов дают порядка миллиарда вариантов, если это не пугает то следующий код, выполненный на пустом листе, поможет сделать брут

[more]
Код:
Sub old()
Dim cols As Integer
cols = 3 'количество колонок автофильтра

' заголовки столбцов для наглядности
For col = 1 To cols
Cells(1, 2 + col).Value = Str(col)
Next

'количество всех вариантов равно 2 в степени количества колонок
'т.о. для 3-х колонок надо перебрать 8 вариантов
For i = 0 To 2 ^ cols - 1
Cells(3 + i, 1).Value = i ' номер варианта

'выбираем колонки для которых нужно включить фильтр для текущего варианта
' если 3 колонки то вариантов 2^3=8
' первый 0 0 0 все без фильтра
' второй 1 0 0 фильтруем по первой
' третий 0 1 0 фильтруем по второй
' и т.д.
For col = 0 To cols - 1
Cells(3 + i, 3 + col).Value = IIf(((i And 2 ^ col) = (2 ^ col)), 1, 0) ' 1 - фильтровать столбец, 0 - не фильтровать
If ((i And 2 ^ col) = (2 ^ col)) Then ' проверяем надо ли включать фильтр колонки с номером 3+col
' надо включить фильтр для колонки с номером 3+col
End If
Next
Next
End Sub

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

FEGORA

Цитата:

с целью получения максимальной суммы в последнем столбце

для максимальной суммы нет смысла делать перебор всех вариантов, чем больше условий фильтрации, тем меньше сумма, следовательно сумма фильтрации по двум столбцам всегда меньше или равна сумме фильтрации по одному из них, так что надо перебрать не все варианты, а только фильтрацию всех столбцов по одному
или я не правильно понимаю задачу?

задача стоит гораздо глубже, эта таблица состоит из ряда условий, и результата к которому эти условия привели. Моя задача попытаться на основании фильтровки условий (которые я знаю заранее) попытаться спрогнозировать результат. Задача данного макроса подобрать оптимальную комбинацию условий на основании фильтровки которой я получу максимальный процент совпадений прогнозиремого результата с реальным. Вот как-то так...
Если честно с кодом не разобрался, можно откомментировать?

прокомментировал в том же сообщении

Всем привет,
Может кто подскажет где у меня ошибка? Запускаю макрос "GetWeather_Click" этим кодом
Sub AutoRunOnTime()
Application.OnTime TimeValue("14:11:10"), "GetWeather_Click"
End Sub

когда делаю это с утра текущего дня - код запускается в 14:11:10 и отрабатывает без проблем. Когда оставляю на выходные, то в понеделник утром вижу, что код "GetWeather_Click" начинает запускаться больше одного раза - это влечет ошибку в другом файле. Как добиться четкого запуска макроса ежедневно в указаное время? Спасибо за помощь.
Пример кода "GetWeather_Click":

[more]
Код:
Private Sub GetWeather_Click()
Application.ScreenUpdating = False
Set SRC = Application.Workbooks("WEATHER2.xls").Sheets("weather")
Set TRG = Application.Workbooks("WEATHER2.xls").Sheets("weather2")
SRC.Activate

Range("A6:e20").QueryTable.Refresh BackgroundQuery:=False
Range("f6:j20").QueryTable.Refresh BackgroundQuery:=False
Range("k6:o20").QueryTable.Refresh BackgroundQuery:=False
Range("p6:t20").QueryTable.Refresh BackgroundQuery:=False
Range("u6:y20").QueryTable.Refresh BackgroundQuery:=False
Range("z6:ad20").QueryTable.Refresh BackgroundQuery:=False
Range("ae6:ai20").QueryTable.Refresh BackgroundQuery:=False

For i = 6 To 20
If SRC.Cells(i, 1) = "3pm" Then
TRG.Cells(2, 6) = SRC.Cells(i, 2)
TRG.Cells(2, 5) = SRC.Cells(i, 3)
End If
If SRC.Cells(i, 6) = "3pm" Then
TRG.Cells(3, 6) = SRC.Cells(i, 7)
TRG.Cells(3, 5) = SRC.Cells(i, 8)
End If
If SRC.Cells(i, 11) = "3pm" Then
TRG.Cells(4, 6) = SRC.Cells(i, 12)
TRG.Cells(4, 5) = SRC.Cells(i, 13)
End If
If SRC.Cells(i, 16) = "3pm" Then
TRG.Cells(5, 6) = SRC.Cells(i, 17)
TRG.Cells(5, 5) = SRC.Cells(i, 18)
End If
If SRC.Cells(i, 21) = "3pm" Then
TRG.Cells(6, 6) = SRC.Cells(i, 22)
TRG.Cells(6, 5) = SRC.Cells(i, 23)
End If
If SRC.Cells(i, 26) = "3pm" Then
TRG.Cells(7, 6) = SRC.Cells(i, 27)
TRG.Cells(7, 5) = SRC.Cells(i, 28)
End If
If SRC.Cells(i, 31) = "3pm" Then
TRG.Cells(8, 6) = SRC.Cells(i, 32)
TRG.Cells(8, 5) = SRC.Cells(i, 33)
End If
Next

TRG.Activate
Cells.Replace What:="°C", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False

TRG.Range("A2:F8").Copy
TRG.Range("A12:F18").Insert Shift:=xlDown
TRG.Range("A12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks.Open Filename:="\\cog\bi_application\data\Weather\WEATHER.xls", UpdateLinks:=False
Set TRG2 = Application.Workbooks("WEATHER.xls").Sheets("Upload weather info")

TRG.Activate
TRG.Range("E2:F8").Copy
TRG2.Activate
TRG2.Range("E2:F8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Run ("WEATHER.xls!UploadToAccess")
Application.DisplayAlerts = False
'ws.Visible = xlSheetVisible

Workbooks("WEATHER.xls").Close SaveChanges:=True
Workbooks("WEATHER2.xls").Save
Application.DisplayAlerts = True
End Sub

ol7ca
в смысле запускается больше одного раза?

ol7ca
а в выходные он запускается или пропускает запуск ?

в help по OnTime написано, что если excel не готов запустить макрос сейчас и не указан LatestTime, то excel ждет готовности бесконечно долго, может в выходной макрос так и не запустился, а excel запустил его в понедельник когда кто-нибудь пришел за компьютер, а потом ещё раз

Drazhar
да

smirnvlad
в субботу уже запускается более одного раза.
а когда он запускается второй раз и пытается обновить управляемый файл, то последний выдает запрос о том, что данные уже записаны - мол, перезаписать? ...и процесс на этом останавливается (т.к. эксель висит с не отвеченным запросом), и в воскресение уже ничего не запускается в указанное время. А когда я в понедельник отказываюсь от перезаписи, макрос продолжает запускаться...я отказываюсь...и так по крайней мере 3 раза - дольше я не ждал и обрывал Ctr+Break. Что-то не могу понять где собака порлась..

ol7ca
а в этом файле нет макросов запускающихся при открытии, сохранении, закрытии
"\\cog\bi_application\data\Weather\WEATHER.xls"
или ещё одного вызова onTime

smirnvlad
Нет. Иначе бы то же самое происходило в течение рабочего дня.

Подскажите, как решить следующую проблему. Нужно перемножить два столбца друг на друга и просуммировать. Я пробовал два подхода:
1. Использовать МУМНОЖ. Удобная функция, но работает только в случае если берется диапазон значений из строки и из столбца. Т.е. перемножить можно строку на столбец, а в моем случае два столбца. То, что МУМНОЖ не может просуммировать два столбца было неприятной неожиданностью.
2. Использовать формулу массива. Например =СУММ(C3:C4*E3:E4) и нажать CTRL+SHIFT+ENTER. Второй вариант работает, но проблема в том, что в ячейке мне нужно выполнить еще несколько операций с полученным значением. Здесь конечно можно через "левую" ячейку сделать, но не очень хочется так делать, как-то неопрятно..
При кажущейся простоте задачи, я в тупике..

ol7ca

Цитата:

Может кто подскажет где у меня ошибка? Запускаю макрос "GetWeather_Click" этим кодом
Sub AutoRunOnTime()
Application.OnTime TimeValue("14:11:10"), "GetWeather_Click"
End Sub

А кто запускает AutoRunOnTime в субботу и воскресенье? Плясать, по-видимому нужно с этого момента.

daMIR
А СУММПРОИЗВ(массив1;массив2) чем не устраивает?

AndVGri

Никто не запускает в выходные. По идее, он должен сам выполняться.

ol7ca
я правильно понял что среди недели файл открывается каждый день заново, может оставить с утра среди недели, и посмотреть на следующий день будет ли лишний запуск и во сколько

smirnvlad
Это все происходит на рабочем компьютере. В процессе рабочей недели я могу контролировать процесс.

Я недавно написал это .."произведение исскуства")) и только начал тестировать...Вероятно, все дело в том, что я не верно использую функцию Application.OnTime - ожидал, что она будет запускать мой код каждый день. Но ведет она себя странно... даже если я несколько раз кликнул на нее и из-за этого она в указанное время запустилась несколько раз.

Наверное, выходом из положения будет установка параметра повтора через 24 часа (Application.OnTime Now + TimeValue("24:00:00")). Я попробую, ... но хочется же понять почему та функция не срабатывает?

Подскажите плиз.
Написал макрос, все делает как я хочу. Получил цифры в нужном представлении типа
" 12 198 670", но в ячейке стоит примечание, что "Число сохранено как текст", если там нажать "преобразовать в число" то получается именно то, что нужно, т.е. вид так же
" 12 198 670", но это уже число, а не текст.

Вот эту операцию "преобразовать в число" мне нужно внести в макрос. А как?

Я рассматривал варианты умножения на 1, функцию ЗНАЧЕН и т.д. получается не тот результат. Число, но в таком виде "12198670", а разделители нужно оставить.
Мудрил с NumberFormat = "General", но что то не срабатывает.

Подскажите плиз.

ol7ca
так таймер сначала удаляется и устанавливаться только один раз
[more]
Код:
Sub AutoRunOnTime()
Application.DisplayAlerts = False
' Отменяем ранее установленный
Application.OnTime EarliestTime:=TimeValue("14:11:10"), Procedure:="GetWeather_Click", Schedule:=False
Application.DisplayAlerts = True

Application.OnTime TimeValue("14:11:10"), "GetWeather_Click"
End Sub

Sub GetWeather_Click()
AutoRunOnTime

остальной код GetWeather_Click()
End Sub

ol7ca
ОК. а если сделать проще.
while 1=1
'Если время нужное, то пускаем нужное приложение.
wend
закинуть в отдельный application и там и запускать.

surgutfred

Цитата:

Мудрил с NumberFormat = "General"

Selection.NumberFormat = "#,##0"

Цитата:

Selection.NumberFormat = "#,##0"

Примерно в таком виде на всех форумах и пишут, но у меня не срабатывает. Возможно я что то путаю.
Если есть желание то вот мой макрос. http://depositfiles_com/files/6fuwl2l44
Запускаете файл макрос, при запуске самого макроса запрашивается исходный файл с данными - указываете файл SmLocF4Kud1.xls.
В столбцах E-J цифры почти все с зеленым флажком, мол в виде текста.
Посмотрите, может я что пропустил.

Свои неудачные попытки я убрал.
Да кстати excel 2007

Здесь в формате 2003 excel http://depositfiles_com/files/3s0zpme4m

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

Когда в столбце выбираешь подряд несколько значений, то в 2007 excele в строке состояния пишется следующая статистика:
Среднее: Количество: Сумма:


Это в случае правильного, нужного мне формата. У меня же показывает только

количество:

Нормального результата я добиваюсь только когда выбираю мышкой преобразовать в число. А в макросе никак.

surgutfred
Я кое-что тебе подправил, остальное сам попробуй довести. Макрос

На текущем листе есть две ячейки с выпадающими списками:
Страна | Область
Сами списки (словарь) расположены на другом листе, вида:
Страна 1
-обл. 1
-обл. 2
Страна 2
-обл. 1
-обл. 2
и т.д.
Как сделать, чтобы во второй ячейке выдавался список по выборке, исходя из условия первой ячейки, т.е. если выбрана Россия, то только российские области.
Спсб.

Здравствуйте!
Помогите, пожалуйста, написать макрос, чтобы он проверял каждую строку таблицы на значение ячеек. И если хоть в одной ячейке строки задано значение "скрыть", то нужно скрыть всю строку. у меня есть макрос со следующим кодом:

[more=код]Sub скрыть()

For rwIndex = 1 To 50
For colIndex = 1 To 30
With Worksheets("Лист1").Cells(rwIndex, colIndex)
If .Value <> "скрыть" Then GoTo сюда
End With
Rows(rwIndex).EntireRow.Hidden = True
сюда:
Next colIndex
Next rwIndex

End Sub[/more]
Он работает, но в нём нужно указывать имя листа и диапазон проверяемых ячеек.
Хотелось бы чтобы макрос всё делал автоматически.

Цитата:

нужно указывать имя листа

Попробуй указывать ActiveSheet т.е. активный, открытый сейчас лист


Цитата:

диапазон проверяемых ячеек

Что то типа
lLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row - последняя строка
lastColumn = Cells.SpecialCells(xlCellTypeLastCell).Column - последний столбец
For rwIndex = 1 To lLastRow
For colIndex = 1 To lastColumn

Помогите пожалуйста со следующей задачей. Нужно по конкретному столбцу убрать лишние пробелы.


Был состряпан вот такой макрос:
Sub Пробелы()
'
' Пробелы Макрос
' Макрос записан 30.09.2010 (gvp)
'
ActiveWorkbook.ActiveSheet.Range(«R2C6»).Select
Do Until IsEmpty(ActiveCell)
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveCell.Offset(1, 0).Select
Loop
End Sub
При запуске макроса выскакивает следующая ошибка:


Debug выделяет следующую строку:
ActiveWorkbook.ActiveSheet.Range(«R2C6»).Select

Кто знает в чем проблема?

Option Explicit

Sub tt()
Dim cc As Range
For Each cc In ActiveWorkbook.ActiveSheet.UsedRange.Columns(2).Cells
cc.Value = Application.WorksheetFunction.Trim(cc.Value)
Next
End Sub

и всё.

surgutfred

Цитата:

Попробуй указывать ActiveSheet

спасибо, работает.