» Excel VBA (часть 3)

Цитата:

Не хочу обнадеживать, но, имо, если в Сети поискать - можно развернутую статистику за года найти. Ужаленых-то полно...

Искал...
asbo, если можешь помочь -помоги.


Итак.
Есть выпавшие номера за 24 игры.
Как сделать, что бы были показаны в отдельно наиболее часто ( наименее часто) выпадающие числа.
Спасибо.

asbo
C msoFileDialogOpen тоже OK. Нормально работают и .Clear и .Add.
Проблемы только с msoFileDialogSaveAs.
"Note A run-time error will occur if the Filters property is used in conjunction with the Clear, Add, or Delete methods when applied to a Save As FileDiaog object. For example, Application.FileDialog(msoFileDialogSaveAs).Filters.Clear will result in a run-time error."

Зачем так сделали непонятно. Довольно глупо.

P.S. Может кто-нить знает, как организовать обработку нажатия Esc (вываливается с ошибкой), при использовании GetSaveAsFilename и GetOpenFilename?

asbo

smirnvlad "нет, все Dialogs предопределены"

это я не про те диалоги, FileDialog отличаются от Dialog

может через win API ?

DmitryPrint

Цитата:

как организовать обработку нажатия Esc (вываливается с ошибкой), при использовании GetSaveAsFilename и GetOpenFilename?

GetSaveAsFilename и GetOpenFilename возвращают False при нажятии Esc, Отмена и закрытии

smirnvlad

Цитата:

это я не про те диалоги, FileDialog отличаются от Dialog

Я только сейчас заметил :) Но суть от этого не меняется. Dialog - так те, понятно, только под себя заточены.

Через WinAPI я уже не буду. Все переписал под GetSaveAsFilename и GetOpenFilename.

DmitryPrint
Жаль, что я начал не с этого диалога, а с msoFileDialogFilePicker :) Я не увидел этого примечания - а оно в самом низу страницы "FileDialogFilters Collection". Да и что мне туда было лезть, если с пикером все заработало :)

smirnvlad, DmitryPrint

Цитата:

GetSaveAsFilename и GetOpenFilename возвращают False при нажятии Esc, Отмена и закрытии

Вот в этом-то и было одно их моих неудобств при переписывании - FileDialog возвращает 0 или -1 Long, а эти - Variant. Да и в примерах где-то сравнивается, как с о строкой "False", а где-то - как с булевым False.

У меня часто возникает ощущение, что этот VBA собран из кубиков от разных конструкторов :) Ну почему, спрашивается, FileDialog возвращает не булевы True False, а соответствующие лонги?... Почему FileDialog реализован, как класс, а эти две - как функции?...

Наплевать... Что есть, с тем и будем работать :)

Цитата:

Вот в этом-то и было одно их моих неудобств при переписывании - FileDialog возвращает 0 или -1 Long, а эти - Variant. Да и в примерах где-то сравнивается, как с о строкой "False", а где-то - как с булевым False.

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Вообще-то возвращается Long.

P.S. Вопрос по Esc отменяется. Неправильно реализовывал обработчик ошибок. Разобрался через Application.EnableCancelKey.

DmitryPrint
Все смешалось в датском королевстве :)
Ты же WinAPI юзаешь. А я про Application.GetSaveAsFilename

asbo

Цитата:

Все смешалось в датском королевстве

Да, таки некоторая каша присутствует
Функции из Application не рассматривал.

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

Amrek

Цитата:

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

Нет. Файл откроется по-любому. Если, конечно, не защищен паролем.
Другое дело, что, если защита ячеек снимается только макросом, тогда они останутся защищенными.

Недавно обсуждали. Неблагодарное занятие :)

Да конечно это неблагодарное занятие защиту обойти можно всегда. Наткнулся вот тут на программку прикольную. Незнаю можно ли тут ссылки оставлять: http://www.excel-vba.ru/general/moi-programmy-dlya-raboty-s-excel/upravlenie-bezopasnostyu-makrosov/ удалите если что. Мне вот интересно как она включает макросы. А так бы сделать exeшник который сначала бы врубал макросы, потом сразу же открывал файл.

А кто помешает файл открыть мимо экзешника?

Подскажите, плз.
Вставляю текст из буфера с помощью ActiveSheet.PasteSpecial потом разбираю его по столбцам через Selection.TextToColumns. Если я делаю это во второй раз с аналогичным по структуре буфером, то PasteSpecial сам разбивает текст по столбцам, что мне очень неудобно.
Как такое автоматическое преобразование отключить?

PS Кстати, эта страница грузит проц в chrome на 50% (как я понял, одно ядро из двух на 100%), когда курсорчег до низу доведёшь.
http://forum.ru-board.com/topic.cgi?forum=33&topic=10903&start=1860#15

Посмотрел, такая же ситуация на всех страницах http://forum.ru-board.com, когда прокручиваешь текст до конца страницы.
Даже точнее, как только в окно браузера попадает стрелочка для расширения окна быстрого ответа (правый нижний угол).
К чему бы это?

Допустим пароль на файл помешает открыть сам файл. Вот как в итоге подсказали решить мою проблему.


Цитата:

Вот текст VBS скрипта:

Sub test()
Dim objXL
Dim Secur
Set objXL = CreateObject("Excel.Application")
objXL.Visible = TRUE
secur = objXL.AutomationSecurity
objXL.AutomationSecurity = 1
objXL.Workbooks.Open replace(Wscript.ScriptFullName,".vbs",".xls"),,,,"4321"
objXL.AutomationSecurity = secur
End Sub

Открывает книгу, имя которой совпадает с именем самого скрипта. Т.е. если скрипт назван Test.vbs, то книга должна быть названа Test.xls. Можно заменить на статичное. На книге установлен пароль на открытие(4321), так что при попытке открыть файл не скриптом ничего не получится.
Состряпать из этого exe-файл нет сложностей - принцип тот же. Код для Exe:

Private Sub Form_Load()
Dim objXL As Object
Dim lSecur As Long
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
lSecur = objXL.AutomationSecurity
objXL.AutomationSecurity = 1
objXL.Workbooks.Open App.Path & "\" & App.EXEName & ".xls", , , , "4321"
objXL.AutomationSecurity = lSecur
Set objXL = Nothing
Unload Me
End Sub

Amrek
Потом начнется - как скомпилить скрипт в экзешник, потом - чем и как его сжать и как защитить от декомпиляции etc. Короче, при современном развитии печатного дела изготовить советский паспорт...
Да и причем здесь VBA, которому посвящена тема?

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

mp65

Цитата:

Как такое автоматическое преобразование отключить?

Жаль, что никто не ответил. СамомУ интересно. У Екселя память на эти дела, связанные с импортом плэйн-текста. Давно хочу разобраться, где это все хранится.

Эх, видимо придётся разборку буфера самому писать.

mp65
Попробуй после перыой разборки по столбцам и перед второй вставкой сэмулировать разборку в другом формате (с другим разделителем, к примеру), чтобы Ексель его запомнил :)

Или разбирай ве сразу, кучей. Но память ему все равно надо будет перед этим отбить :)

Цитата:

Попробуй после перыой разборки по столбцам и перед второй вставкой сэмулировать разборку в другом формате (с другим разделителем, к примеру), чтобы Ексель его запомнил

Использование другого формата разборки ничего не сбрасывает. Получилось так:
берём некую не пустую ячейку, делаем по ней разборку по столбцам с каким-нибудь жутким OtherChar, которого заведомо не будет в тексте, что будем потом разбирать.
Это частично решает проблему. Правда, есть шанс, что попадётся буфер с таким специфическим символом и, как следствие, при разборе вылетит ошибка.
Такое вот почёсывание левого уха правой ногой по милости MS.
Наверное, есть какой-нибудь способ занулить данные в классе, ну забыли они это сделать, или оставили специально для "удобства" пользователей.

Добрый день.

Есть файл excel с "только для чтения" для создания заявок (либо только для выгрузки для знающих пароль). У большинства сотрудников он работает нормально, однако у некоторых возникает ошибка "Гы гы гы..." (это не стеб - в коде есть эта ошибка). Может кто подсказать, что именно ее может вызывать, если настройки у всех одинаковые, а ошибка может возникать у случайного сотрудника (хотя есть люди у которых она постоянно).
p.s. я пытался логически прийти к проблеме,но сей язык прог-я я не знаю... поэтому очень надеюсь на любую помощь...
[more=собсно код]Sub Создание_реестра()
Dim ee As String
Naim1 = ActiveWorkbook.Name
Basa = "База данных"
ee = InputBox("Введите номер месяца и год для которого необходимо создать новый файл", "Деньги от филиала")
If ee = "" Then
Exit Sub
End If
temps = CStr(Trim(ee))
'Chislo = CStr(Left(temps, 2))
mes = CStr(Left(temps, 2)) 'CStr(Right(Left(temps, 5), 2))
god = CStr(Right(temps, 2))
'datstr = Chislo + Mes + God
Sheets("Реестр_шаблон").Select
Sheets("Реестр_шаблон").Copy
ActiveWorkbook.SaveAs Filename:= _
"Z:\Zayavki_reestr\2011\Reestr_" & mes & "_20" & god & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

Sheets("Реестр_шаблон").Select
Sheets("Реестр_шаблон").Name = "01" & mes & god
d = "01/" & mes & "/" & god
dd = CDate(d)
Range("B1") = dd
If (mes = "01" Or mes = "03" Or mes = "05" Or mes = "07" Or mes = "08" Or mes = "10" Or mes = "12") Then
Days = 31
ElseIf (mes = "04" Or mes = "06" Or mes = "09" Or mes = "11") Then
Days = 30
Else
Days = 29
End If
Sheets(1).Select
For i = 2 To Days
Sheets(1).Select
Sheets(1).Copy After:=Sheets(i - 1)
Sheets(i).Select
If i > 9 Then
ii = i
Else
ii = "0" & i
End If
nazv = ii & mes & god
Sheets(i).Name = ii & mes & god
Range("B1").Select
rr = ii & "/" & mes & "/" & god
r = CDate(rr)
Range("B1").Value = r
Next
Worksheets(1).Activate
Range("B5").Select
ActiveWorkbook.Close savechanges:=1
End Sub

Sub Реестр_занесение()

Dim zanes(100) As Variant

On Error Resume Next
zayavki = ActiveWorkbook.Name

data = Workbooks(zayavki).Sheets("Шаблон").Cells(3, 5)
chislo = Left(data, 2)
mes = Right(Left(data, 5), 2)
god = Right(data, 2)
datstr = chislo & mes & god
datstr1 = "01" & mes & god

'COUNTER START
' foldcounter = "Z:\Zayavki_reestr\20" & god & "\"
foldcounter = "Z:\Zayavki_reestr\2011\"
filecounter = "Counter.xls"
pathcounter = foldcounter & filecounter
Workbooks.Open Filename:=pathcounter, ReadOnly:=0, Password:="0101"

zcounterold = Workbooks(filecounter).Sheets("1").Cells(1, 256)

If zcounterold = 0 Then
Workbooks(filecounter).Close savechanges:=0
Application.ScreenUpdating = True
MsgBox ("Ошибка,.. ну ты и зануда ..попробуйте еще раз...")
Exit Sub
End If

zcounter = zcounterold + 1
Workbooks(filecounter).Sheets("1").Cells(1, 256) = zcounter
Workbooks(filecounter).Sheets("1").Cells(1, 255) = chislo

Workbooks(filecounter).Close savechanges:=1
'COUNTER END

Workbooks(zayavki).Sheets("Шаблон").Cells(1, 16) = zcounter

zanes(1) = zcounter


'дата заявки
zanes(3) = Workbooks(zayavki).Sheets("Шаблон").Cells(3, 5)
'инициатор
zanes(4) = Workbooks(zayavki).Sheets("Шаблон").Cells(5, 5)
'сумма
zanes(5) = CDbl(Workbooks(zayavki).Sheets("Шаблон").Cells(25, 5))
'курс
zanes(6) = Workbooks(zayavki).Sheets("Шаблон").Cells(22, 16)
'платёж
zanes(7) = "=RC[-2]*RC[-1]"
'комментарий
zanes(8) = Workbooks(zayavki).Sheets("Шаблон").Cells(27, 5)
'статус
zanes(9) = 2
'предполагаемая дата платежа
zanes(10) = Workbooks(zayavki).Sheets("Шаблон").Cells(3, 16)
'клиент
zanes(11) = Workbooks(zayavki).Sheets("Шаблон").Cells(7, 5)
'договор
zanes(12) = Workbooks(zayavki).Sheets("Шаблон").Cells(8, 5)
'приложение
zanes(13) = Workbooks(zayavki).Sheets("Шаблон").Cells(9, 5)
'проект
zanes(14) = Workbooks(zayavki).Sheets("Шаблон").Cells(11, 5)
'статья
zanes(15) = Workbooks(zayavki).Sheets("Шаблон").Cells(13, 5)
'город
zanes(16) = Workbooks(zayavki).Sheets("Шаблон").Cells(15, 5)
'контрагент
zanes(17) = Workbooks(zayavki).Sheets("Шаблон").Cells(17, 5)
'договор
zanes(18) = Workbooks(zayavki).Sheets("Шаблон").Cells(18, 5)
'приложение
zanes(19) = Workbooks(zayavki).Sheets("Шаблон").Cells(19, 5)
'расчёт
zanes(20) = Workbooks(zayavki).Sheets("Шаблон").Cells(21, 5)
'валюта
zanes(21) = Workbooks(zayavki).Sheets("Шаблон").Cells(21, 16)
'счёт
zanes(22) = Workbooks(zayavki).Sheets("Шаблон").Cells(23, 5)
'группа
If zanes(11) = "Офис" Then zanes(23) = "Офис" Else zanes(23) = "Проект"

zanes(26) = "=IF(AND(RC[-6]=""Наличный"", RC[-17]=3, NOT(ISERROR(RC[-19]-RC[-1]))), RC[-19]-RC[-1],"""")"

zanes(28) = Workbooks(zayavki).Sheets("Шаблон").Cells(1, 256)

zanes(29) = "=CONCATENATE(RC[-18],"" - "",RC[-15])"

zanes(30) = CInt(Workbooks(zayavki).Sheets("Шаблон").Cells(5, 256)) + 1

zanes(31) = "NEW"

'налог
zanes(32) = Workbooks(zayavki).Sheets("Шаблон").Cells(25, 12)
Application.Calculation = xlManual


'For m = 1 To 31
For m = 1 To 32


Workbooks(zayavki).Sheets("реестр_шаблон").Cells(1, m) = zanes(m)
Next m

Workbooks(zayavki).Sheets("реестр_шаблон").Cells(1, 26).FormulaR1C1 = zanes(26)
Workbooks(zayavki).Sheets("реестр_шаблон").Cells(1, 29).FormulaR1C1 = zanes(29)


Application.Calculation = xlAutomatic

Workbooks(zayavki).Sheets("реестр_шаблон").Activate
Range("A1:Ag1").Select
Selection.Copy

'Application.CutCopyMode = False

' foldreestr = "Z:\Zayavki_reestr\20" & god & "\"
foldreestr = "Z:\Zayavki_reestr\2011\"

reestr = "Reestr_" & mes & "_20" & god & ".xls"
pathreestr = foldreestr & reestr
Workbooks.Open Filename:=pathreestr, ReadOnly:=0, Password:="0505", WriteResPassword:="0505"

'CHG2
If Workbooks(reestr).Sheets(datstr).Cells(1, 2) = "" Then
Workbooks(reestr).Close savechanges:=0


Application.CutCopyMode = False

Workbooks(zayavki).Sheets("реестр_шаблон").Activate
Sheets("реестр_шаблон").Select
Range("A1:AF1").Select
Selection.ClearContents

Module1.clear_shablon

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic


MsgBox ("Ошибка, гы гы попробуйте еще раз...")
Exit Sub
End If

'zcounterold = Workbooks(reestr).Sheets(datstr1).Cells(1, 256)
'zcounter = zcounterold + 1
'Workbooks(reestr).Sheets(datstr1).Cells(1, 256) = zcounter
'Workbooks(reestr).Sheets(datstr1).Cells(1, 255) = chislo
'Workbooks(zayavki).Sheets("Шаблон").Cells(1, 16) = zcounter
'zanes(1) = zcounter

Workbooks(reestr).Sheets(datstr).Activate
n = 4
While Workbooks(reestr).Sheets(datstr).Cells(n, 1) <> ""
n = n + 1
Wend

'm = 1
'While Workbooks(reestr).Sheets(datstr).Cells(3, m) <> ""
'Workbooks(reestr).Sheets(datstr).Cells(n, m) = zanes(m)
'm = m + 1
'Wend

Workbooks(reestr).Sheets(datstr).Cells(n, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False


' *ZANESENIE*
'For m = 1 To 27
' Workbooks(reestr).Sheets(datstr).Cells(n, m) = zanes(m)
'Next m
'Workbooks(reestr).Sheets(datstr).Cells(n, 24).FormulaR1C1 = zanes(24)
'Workbooks(reestr).Sheets(datstr).Cells(n, 26).FormulaR1C1 = zanes(26)
' //

Workbooks(reestr).Close savechanges:=1

Workbooks(zayavki).Sheets("реестр_шаблон").Activate
Sheets("реестр_шаблон").Select
Range("A1:AF1").Select
Selection.ClearContents


End Sub


Sub Смета_занесение()

zayavki = ActiveWorkbook.Name
klient = Workbooks(zayavki).Sheets("Шаблон").Cells(7, 5)
proekt = Workbooks(zayavki).Sheets("Шаблон").Cells(11, 5)
klpr = klient & " - " & proekt
ttt = "0101"

smet1folder = "Z:\Zayavki_reestr\2011\"
smet1 = "smet1.xls"
smet1path = smet1folder & smet1
Workbooks.Open Filename:=smet1path, ReadOnly:=0, Password:=ttt

wscount = Workbooks(smet1).Sheets.Count

For i = 1 To wscount
If Workbooks(smet1).Sheets(i).Name = klpr Then GoTo ok2
Next i
Workbooks(smet1).Close savechanges:=0
MsgBox ("Ошибка! Нет данных о смете проекта "" " & klpr & "")
Exit Sub

ok2:

m = CInt(Workbooks(zayavki).Sheets("Шаблон").Cells(5, 256))

Workbooks(smet1).Sheets(klpr).Cells(m + 1, 3) = Workbooks(smet1).Sheets(klpr).Cells(m + 1, 3) + CDbl(Workbooks(zayavki).Sheets("Шаблон").Cells(25, 5))

Workbooks(smet1).Close savechanges:=1

End Sub


Sub procedure_prn()

'xxx
If Sheets("Шаблон").Cells(5, 256) = "" Then
MsgBox ("Необходимо заново создать заявку через кнопку ""Создать заявку""")
Sheets("Запуск").Activate
Exit Sub
End If

Application.ScreenUpdating = False
Module1.Реестр_занесение

If Sheets("Шаблон").Cells(1, 16) = "" Then
Application.ScreenUpdating = True
Exit Sub
End If

If Sheets("Шаблон").Cells(5, 256) <> "" Then
If CInt(Sheets("Шаблон").Cells(5, 256)) > -1 Then
Module1.Смета_занесение
End If
End If
Sheets("Шаблон").Cells(5, 256) = ""


Sheets("Шаблон").Activate


'ZZZ
ActiveSheet.PageSetup.PrintArea = "$A$1:$R$47"
Range("P1:R1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

'CommandBars("Standard").Controls(6).Enabled = True

Sheets("Запуск").Activate
Application.ScreenUpdating = True

End Sub


Sub clear_shablon()

Sheets("Шаблон").Range("p1:r3").ClearContents
Sheets("Шаблон").Range("p21:r22").ClearContents
Sheets("Шаблон").Range("e5:r19").ClearContents
Sheets("Шаблон").Range("e21:h25").ClearContents
Sheets("Шаблон").Range("e27:r31").ClearContents
Sheets("Шаблон").Range("k25:r25").ClearContents

End Sub
[/more]

flexoleonhart, лучше под тег 'more' положить код, а не под коврик.


Добавлено:
flexoleonhart
Ячейка B1 на листе данной даты в файле реестра за данный месяц - пустая.
Надо поставить точку останова в этом месте и исследовать ситуацию в момент ее возникновения.

Подскажите, плз, могу ли я используя функцию Win API - SendMessage послать в стороннее приложение последовательности Ctrl-Shift-S, Alt-Q и т.д.? Если да, то как?
Понятно, что можно использовать keybd_event, но для этого, как я понял, нужно активировать это внешнее приложение, а это нежелательно, т.к. не совсем понятно какое приложение в данный момент в ForeGround-е, кроме того, возникают проблемы с нормальным возвращением в активное в данный момент приложение.
Опишу задачу несколько по другому. Есть таблица Excel и несколько внешних приложений, которые прямо или косвенно передают данные в эту таблицу. На основе этих получаемых данных коду VBA Excel нужно посылать в эти приложения последовательности нажатий на клавиши, причём, все эти посылки не должны приводить к изменениям экрана пользователя. Например, по ходу работы надо послать для обновления содержимого страницы F5 в Foogle Chrome, а этот момент активно совсем другое приложение и если сделать AppActivate "Google Chrome" будет совсем не гуд, это помешает работе.

mp65 - можете. только вызывать придется внешний обработчик vbs скриптов, на сколько я помню. По крайней мере я писал в макросе хекселя эмуляцию нажатия клавиш.

mp65
Может совсем в другую сторону посмотреть - встроить InternetExplorer и работать с ним, как с объектом...

Johnson Finger
Цитата:

mp65 - можете. только вызывать придется внешний обработчик vbs скриптов, на сколько я помню. По крайней мере я писал в макросе хекселя эмуляцию нажатия клавиш.

Пока написал с keybd_event, приходится активировать внешнее приложение, а не просто посылать ему message, как-то это кривовато.
Внешний обработчик vbs скриптов, это для меня пока тёмный лес, может примерчик подкинете?

asbo
Цитата:

mp65
Может совсем в другую сторону посмотреть - встроить InternetExplorer и работать с ним, как с объектом...

Я думал об этом, позапускать из excel нужные приложения и использовать их PID-ы, но это неудобно, поскольку они могут быть в любой момент закрыты пользователем, а при необходимости заново запущены.
Я не до конца разобрался с последовательностью поиска доступа к объектам внешнего приложения
ihWnd = FindWindow(...
ihWnd = FindWindowEx(...
ihWnd = FindWindowEx(...
...
но, даже когда я найду объект и универсальный алгоритм поиска для моих случаев, всё равно не понятно, как здесь использовать sendmessage для посылки хоткеев.

mp65
Нет-нет. Я имел ввиду подключение к проекту Microsoft Internet Controls (ieframe.dll)
Dim oApp As SHDocVw.InternetExplorer
Вот отсюда кратенькое обсуждение на днях было.

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

asbo
Цитата:

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

Дело в том, что мне нужно использовать объект, который не я создаю, а пользователь.
Обновление окна Google Chrome я привёл просто в качестве примера, есть ещё приложения, которыми надо управлять, но структуры объектов которых я не знаю, могу только посмотреть и догадаться о том, откуда считывать и как и что класть.

Есть массив неповторяющихся чисел. Надо составить из них возможные комбинации (пары), но только прямые. Прямые, как я это обозвал :), значит, что канают только 1-2, 1-3, 2-3, но не 2-1, 3-1 и 3-2. Ну, или наоборот. Т.е. или то, или другое.

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

Концепция такова - перемещаясь от элемента к элементу, составляем комбинации только со следующими (оставшимися) элементами, но не с предыдущими, т.к. при проходе предыдущих они в этот элемент ужЕ смотрели. Собственно парсер за звездами. [more=Вот код]

Код:
Sub sb_DCombi()
Dim i%, j%, k%, iLB%, iUB%, iQty%, iSrc%(), iTgt%()

iQty = 5 ' set source array size
ReDim iSrc(1 To iQty)

iLB = LBound(iSrc): iUB = UBound(iSrc)
For i = iLB To iUB ' fill source array
iSrc(i) = i ' * 2
Next

' *** *** Parser
For i = iLB To iUB ' fill target array
For j = i + 1 To iUB
k = k + 1 ' add new pair
ReDim Preserve iTgt(1 To 2, 1 To k)
iTgt(1, k) = iSrc(i)
iTgt(2, k) = iSrc(j)
Debug.Print iTgt(1, k); iTgt(2, k)
Next
Next
Debug.Print vbLf
' *** ***

iLB = LBound(iTgt, 2): iUB = UBound(iTgt, 2)
For i = iLB To iUB ' check & display target array
Debug.Print iTgt(1, i); iTgt(2, i)
Next
End Sub

Интересный эффект обнаружил, похоже, что iif отличается от if. Идентичные по сути конструкции выдают разные результаты при TickLotA(i)<>0 и VolSdAcAr(i)=0&
If VolSdAcAr(i) <> 0& Then
Worksheets("Bid-Ask").Cells(i, 19) = Abs(Worksheets("Bid-Ask").Cells(i, 17) /(VolSdAcAr(i) * TickLotA(i)))
Else
Worksheets("Bid-Ask").Cells(i, 19) = ""
End If
даёт, как и должно, ""
а
Worksheets("Bid-Ask").Cells(i, 19) = IIf(VolSdAcAr(i) <> 0&, Abs(Worksheets("Bid-Ask").Cells(i, 17) / (VolSdAcAr(i) * TickLotA(i))), "")
генерирует ошибку Деление на ноль.
Что за чудеса?

mp65
IIf считает сразу обе части - и true и false. Поэтому, когда VolSdAcAr(i) = 0& первая часть дает ошибку деления на ноль. Поэтому я ее (IIf) не люблю.
Bid-Ask=Spread ;)

Добавлено:
Бзв - в хелпе слово в слово то же самое :))

Цитата:

Remarks: IIf always evaluates both truepart and falsepart, even though it returns only one of them. Because of this, you should watch for undesirable side effects. For example, if evaluating falsepart results in a division by zero error, an error occurs even if expr is True.