Спасибо огромное! В яблочко   )))

Добрый день!
Имеется лист с картинками в столбце А:А (картинка находится в ячейке) и артикулом в столбце В:В. Как с помощью цикла пройтись по листу и выгрузитьв папку картинки с именем артикула из столбца B:B?
Суть проблемы - адрес картинки. Как узнать ячейку в которой находится картинка?

Видимо, я неправильно поставил вопрос
Существуют 2 надстройки, которые не работают при открытой книге макросов. А хотелось бы
При подключении их как библиотек возникает проблема описанная выше.
Какие еще есть варианты решения проблемы (кроме собраться с духом и написать функции, аналогичные тем, что в надстройках, и вставить их во все рабочие файлы)?

Добрый день.

На  работе, до моего прихода, были установлены 2 надстройки и все ими пользуются. Для выполнения своих задач я создал книгу макросов. Ранее она конфликтовала с этими надстройками. То есть, когда подключена книга макросов, надстройки, в которых хранятся формулы не работали. Приходилось закрывать книгу макросов, и уже после открывать нужные файлы, чтобы в них корректно работали надстройки.

Недавно, я подключил данные надстройки в качестве библиотек к своей книге макросов (Tools-References). И конфликты прекратились ))
Зато, когда я закрываю книгу макросов выскакивает сообщение: "На эту книгу имеются ссылки из других книг, так что закрыть её нельзя." Также перестали выполняться действия, которые должны происходить во время открытия и закрытия книги макросов (Workbook_BeforeClose, Workbook_Open)

Кто-нибудь сталкивался с подобной проблемой?

Будем учиться

Не дописал условие  - кнопки на форме, а не на листе.

Добрый день!

Возникла необычная задача.

Имеется множество кнопок в имени которых имеется номер. Их можно перебирать в цикле с помощью Object("But" & a1). При нажатии любой кнопки выполняется однотипная операция над свойствами данной  кнопки.
Для нажатия кнопки необходимо описать все действия в макросах типа Private Sub but1_Click(). А кнопок много  

Можно ли внести переменную в название функции , или назвать функцию неявно, с помощью маски?
Принимаются любые варианты.

Договорились;)

я не про это . Например, в Visual Studio есть комбинация клавишь CTRL+K+F. Т.е. выделяемвесь код, жмакаем и структурирован весь код, как показано в http://www.oaltd.co.uk/Indenter/

Есть ли такое в среде экселя по умолчанию (без доп программ)?

Smart Indenter - вероятно, хорошая вещь, но дома. А на работе как быть? Продумано ли структурирование в родной среде? Например, комментировать и раскомментировать можно, а вот структурировать

Добрый день.

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

Огромное спасибо! Это решает проблему.

Добрый вечер, форумчане! Возникла следующая задача. Имеются книги с данными. Из них необходимо вытащить данные по критериям, указанным в CheckBox, которых 5. Если CheckBox=True, то данные критерии сшиваются через разделитель в единый критерий и по нему подтягиваются данные(цифры). Данные из книг забираются с помощью сurrentRegion.Value

Проблема в том, что если я хочу выбрать не все CheckBox а несколько, то при сшивании необходимо выстраивать  лесенку if-else, а критериев 5, т.е. 25 вариантов и лестница большая получается. Например:

If CheckBox1 = True And CheckBox2 = True And CheckBox3 = True And CheckBox4 = True And CheckBox5 = True Then
        t = a(i, l2) & "|" & a(i, l8) & "|" & a(i, l7) & "|" & a(i, l20) & "|" & a(i, l21)
else if
....
          End If
, где a - массив, сформированный из листа через  a=[a1].сurrentRegion.Value;
l - номер столбца критерия в каждом массиве а;
i - номер строки.


И на выходе процедуру придется повторить. Порекомендуйте варианты как обойти такое неудобство.

правда не макрос:(

ввести и нажать ctrl+shift+enter  
=СУММ(ЕСЛИ(СЧЁТЕСЛИ(A2:D2;A1:D1);1))  
или просто:  
=ЕСЛИ(СЧЁТЕСЛИ(A2:D2;A1)=0;0;1)+ЕСЛИ(СЧЁТЕСЛИ(A2:D2;B1)=0;0;1)+ЕСЛИ(СЧЁТЕСЛИ(A2:D2;C1)=0;0;1)+ЕСЛИ(СЧЁТЕСЛИ(A2:D2;D1)=0;0;1)

Разобрался:)  
 
For i = min To max  
counts(list(i)) = counts(list(i)) + 1    
Next i  
- для каждого элемента массива лист подсчитываем кол-во его появлений в массиве.  
For i = min_value To max_value ' эти 5 строчек -лес дремучий  
For j = 1 To counts(i)  
list(next_index) = i  
next_index = next_index + 1  
Next j  
Next i  
- идем от минимального значения сортируемого массива к максимальному с шагом 1. Если элемент не встречается, то counts(i)=empty, и попадаем во внешний цикл. И получаем отсортированый массив.

Добрый вечер! Помогите, пожалуйста, расшифровать работу данного кода. Нахождение минимума и максимума понятно. Не понятно как работает со строки : 'Подсчет значений.    
Sub Countingsort(list)  
   Dim counts() As Long  
   Dim i As Long  
   Dim j As Long  
   Dim next_index As Long  
   Dim min, max  
   Dim min_value As Variant, max_value As Variant  
 
   min_value = Minimum(list)  
   max_value = Maximum(list)  
 
   min = LBound(list)  
   max = UBound(list)  
     
   ReDim counts(min_value To max_value)  
     
   ' Подсчет значений.  
   For i = min To max  
       counts(list(i)) = counts(list(i)) + 1 ' не понятно как работает данная строка, ведь размерность массива counts от минимального до максимального значения массива list. А влезет ли? При тестировании влазит, но каким образом?  
   Next i  
 
   ' Повторное занесение значений в массив.  
   next_index = min  
   For i = min_value To max_value  ' эти 5 строчек -лес дремучий  
       For j = 1 To counts(i)  
           list(next_index) = i  
           next_index = next_index + 1  
       Next j  
   Next i  
End Sub  
 
Private Function Maximum(l)  
   Dim s1, s2  
   Dim i  
   s1 = LBound(l)  
   s2 = UBound(l)  
   Maximum = l(s1)  
   For i = s1 To s2  
       If l(i) > Maximum Then Maximum = l(i)  
   Next i  
End Function  
 
Private Function Minimum(l)  
   Dim s1, s2  
   Dim i  
   s1 = LBound(l)  
   s2 = UBound(l)  
   Minimum = l(s1)  
   For i = s1 To s2  
       If l(i) < Minimum Then Minimum = l(i)  
   Next i  
End Function

выяснилось, что Конмесяца появляется только в 2007:(  
 
Огромное спасибо Игорю67!!! :-)

Ужас, как сложно, но работает! Огромное спасибо! Буду разбираться.

Добрый вечер! Необходимо добавить несколько столбцов перед указанной ячейкой. Добавить 1 столбец легко:  
Sub aa()  
Columns(k).Insert  
End Sub  
где вместо к можно указать нужное число. А вот что делать, если надо добавить несколько столбцов и не известно, как они показаны в буквенном выражении. Причем заранее неизвестно сколько столбцов. Т.е. нужно что-то типа: Columns(k:(k+5)).Insert  
 
Как это сделать?

{quote}{login=vikttur}{date=04.10.2012 10:41}{thema=}{post}=ДЕНЬ(КОНМЕСЯЦА(A1;0)){/post}{/quote}  
:-)

{quote}{login=ABC}{date=04.10.2012 10:15}{thema=}{post}=КОНМЕСЯЦА(A1;0)-ДАТА(ГОД(A1);МЕСЯЦ(A1);1)+1{/post}{/quote}  
не знал про конмесяца;) Огромное спасибо! Проще =день(конмесяца(А1;0))

Добрый вечер! Меня давно мучает этот вопрос, сколько дней в месяце, да еще и если в феврале их переменное кол-во. При переходе в новый месяц постоянно нужно переделывать формулы, под нужное кол-во дней. А лень:) Подскажите как справиться с этой проблемой раз и навсегда.  
 
Условие: В ячейке А1 стоит текущая дата. Найти: кол-во дней в текущем месяце.

Класс! Я и не думал, что можно вот так с массивом))) Огромное спасибо!

{quote}{login=Hugo}{date=20.06.2012 08:51}{thema=}{post}Если данные такие, как в примере - то нужен один временный массив для данных (чтоб лист не перебирать) и словарь для ключей и сумм. Можно в item словаря тоже класть небольшой массив - если сумм больше чем одна.  
Думаю Вам стоит изучить словарь.{/post}{/quote}  
А как в item положить массив n-го размера, если сумма не одна?

Спасибо:) Теперь буду словари осваивать.

{quote}{login=vikttur}{date=21.06.2012 02:58}{thema=Re: }{post}Зачем загромождать тему длинным листингом?{/post}{/quote}  
Спасибо, учту.

Огромное спасибо, Hugo! Словари рулят:)Производительность всегда в почете. Все разобрал, вот только в коде есть строчка:  
For Each kk In .keys      в ней CreateObject("Scripting.Dictionary").keys - это сам уже сформированный словарь?

Какая необычная идея. Подумаю как её лучше реализовать.

Если кратенько. Есть статистика за несколько лет, собраная в книгах (срезы за период). Её необходимо обработать, для этого нужно объединять несколько книг в одну. Часть данных переносится (типа "название" и т.п.), часть суммируется(сумма). Проблема в том что эксель 2003. И просто собрать данные на 1 лист я не могу. делаю следующее:  
1. Открываю книги по очереди  
2. Лист в массив загоняется  
3. Массив обрабатывается, в результате имеем динамический массив  с невыясненым кол-вом элементов  
4. Эти массивы объединяются в один и вставляются в книгу. И тут желательно, чтобы пустых строк не было, т.к. не влезет и некрасиво.  
Файл прилагаю. Его можно размножить (копированием) и посмотреть итог. код:  
 
Sub массив3()  
Dim aa(), bb() As Variant, cc() As Variant, dd(), ee(), gg(), hh(), ll(), a%, b%, c%, e%, f%, g%, h%  
ReDim dd(1 To 1000, 1 To 4)  
h = 1  
With Application  
v = .GetOpenFilename("Excel Files (*.xl*),*.xl*,All Files (*.*),*.*", , "Выберите файлы", , True)  
If Not IsArray(v) Then Exit Sub  
.EnableEvents = False  
.ScreenUpdating = False  
.DisplayAlerts = False  
   For Each x In v  
   Application.Workbooks.Open (x)  
       d = 1  
 
         
           aa = [a1].CurrentRegion.Value
           cc = [a1].CurrentRegion.Value
           ReDim bb(1 To UBound(aa), 1 To 4)  
               For a = LBound(aa) To UBound(aa)  
                   For b = a + 1 To UBound(aa)  
                       If aa(a, 1) = aa(b, 1) And aa(a, 2) = aa(b, 2) Then aa(b, 1) = ""  
                   Next b  
               Next a  
       For c = LBound(aa) To UBound(aa)  
           If aa(c, 1) <> "" Then: bb(d, 1) = aa(c, 1): bb(d, 2) = aa(c, 2): d = d + 1  
       Next c  
   For e = LBound(bb) To UBound(bb)  
       For f = LBound(cc) To UBound(cc)  
           If (bb(e, 1) = cc(f, 1)) And (bb(e, 2) = cc(f, 2)) Then bb(e, 3) = cc(f, 3): bb(e, 4) = bb(e, 4) + cc(f, 4)  
       Next f  
   Next e  
    ActiveWorkbook.Save  
ActiveWorkbook.Close  
   .Workbooks.Add  
   [a1:d1].Resize(UBound(bb)) = bb
   ee = [a1].CurrentRegion.Value
   ActiveWorkbook.Close  
      For g = LBound(ee) To UBound(ee)  
     dd(h, 1) = ee(g, 1)  
     dd(h, 2) = ee(g, 2)  
     dd(h, 3) = ee(g, 3)  
     dd(h, 4) = ee(g, 4)  
     h = h + 1  
       Next g  
         
Next  
 
.Workbooks.Add  
 
[a1:d1].Resize(UBound(dd)) = dd
 
d5 = 1  
 
 
gg = [a1].CurrentRegion.Value
ll = [a1].CurrentRegion.Value
ReDim hh(1 To UBound(gg), 1 To 4)  
For a5 = LBound(gg) To UBound(gg)  
   For b5 = a5 + 1 To UBound(gg)  
       If gg(a5, 1) = gg(b5, 1) And gg(a5, 2) = gg(b5, 2) Then gg(b5, 1) = ""  
   Next b5  
Next a5  
   For c5 = LBound(gg) To UBound(gg)  
           If gg(c5, 1) <> "" Then: hh(d5, 1) = gg(c5, 1): hh(d5, 2) = gg(c5, 2): d5 = d5 + 1  
   Next c5  
For e5 = LBound(hh) To UBound(hh)  
For f5 = LBound(ll) To UBound(ll)  
   If (hh(e5, 1) = ll(f5, 1)) And (hh(e5, 2) = ll(f5, 2)) Then hh(e5, 3) = ll(f5, 3): hh(e5, 4) = hh(e5, 4) + ll(f5, 4)  
Next f5  
Next e5  
.Workbooks.Add  
[a1:d1].Resize(UBound(hh)) = hh
End With  
End Sub