» Excel VBA (часть 2)

vasiliy74
к слову, лучше то, что можно сделать без выделения, делать без него. например:
Код: With Sheets("Лист1").Cells
.ClearContents
.ClearComments
End With

Troitsky
Спасибо что посвятил!! РАБОТАЕТ! ух сколько щя. я поправлю летать просто всё будет

Добавлено:
Вот типа решил написать удаление строк с нулевыми значениями в столбце D
немогу понять как её удалить? удаляю только ячейку


Код: Dim start_cell As Range
Set start_cell = Worksheets("Total_E").Cells(2, "D")
With Worksheets("Total_E")
Set in_r = Range(start_cell, start_cell.End(xlDown))
'in_r.Select 'проверка выбора диапозона
End With
index = start_cell.End(xlDown).Row
While index > 1
If in_r.Cells(index, 1) = 0 Then
With Worksheets("Total_E")
.Cells(index, 1).Delete Shift:=xlUp 'А меня строку удалить нужно как?*
End With
End If
index = index - 1
Wend

vasiliy74

Цитата:

Вот типа решил написать удаление строк с нулевыми значениями в столбце D

Код: For Each r In ActiveSheet.UsedRange.Rows
If Cells(r.Row, 4) = 0 Then r.Delete
Next

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

vasiliy74

Цитата:

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

следующие за удаленной строкой строки вверх и сдвигаются. сам же писал
Цитата:

удаление строк с нулевыми значениями в столбце D

Или тебе нужно удалять только ячейки из этого диапазона, удовлетворяющие условию? со сдвигом каждой следующей на позицию вверх? тогда
Код: For Each r In ActiveSheet.UsedRange.Rows
If Cells(r.Row, 4).Value = 0 Then Cells(r.Row, 4).Delete Shift:=xlUp
Next

Цитата:

Вот такой код подойдет?

Сложно
Вот теперь у меня всё работает!

Код:
Dim start_cell As Range
Set start_cell = Worksheets("Total_E").Cells(2, "D")
With Worksheets("Total_E")
Set in_r = Range(start_cell, start_cell.End(xlDown))
End With
index = start_cell.End(xlDown).Row - 1
While index > 1
If in_r.Cells(index, 1).Value = 0 Then
With Worksheets("Total_E")
.Rows(index + 1).Delete Shift:=xlUp
End With
End If
index = index - 1
Wend

Ребята, такая вот ситуация и незнаю как выйти... помогите разобратся:
есть форма в которую вноситься заказ, из нее при помощи функции "ВПР" количества переносятся в "козу" для составления инвойса, напротив артикулов, которые были заказаны стоят соответствующие количества, напротив тех артикулов, коих не заказывали соответственно стоят нули, а напротив названий групп стоит "Н\Д"....
далее приходиться в ручную удалять позиции напротив которых мы имеем 0 или же "Н\Д"...
суть вопроса: можно ли както сделать чтобы вручную не удалять строки с артикулом которые отображаються как 0 или "Н\Д".... тоесть это делалось автоматически! или хотябы чтобы выделялось цветом позиции которые подлежат удалению... автофильтр тут неприемлим.
Заранее спасибо!

Код:
Sub macros()
n1 = 1 'номер первой колонки'
n2 = 3 'номер второй колонки'
For i = 1 To 10000

If (Cells(i, n1) = "Н\Д") Or (Cells(i, n2) = 0) Then
Range(Cells(i, 1), Cells(i, 10)).Select
With Selection.Interior
.ColorIndex = 3 'цвет'
.Pattern = xlSolid
End With
End If
Next i
Cells(1, 1).Select
End Sub

Цитата:

Sub macros()
n1 = 1 'номер первой колонки'
n2 = 3 'номер второй колонки'
For i = 1 To 10000

If (Cells(i, n1) = "Н\Д") Or (Cells(i, n2) = 0) Then
Range(Cells(i, 1), Cells(i, 10)).Select
With Selection.Interior
.ColorIndex = 3 'цвет'
.Pattern = xlSolid
End With
End If
Next i
Cells(1, 1).Select
End Sub

это я так понимаю только выделение цветом! а что подразумевается под "номер первой колонки" "номер второй колонки"?

Nickolasha

Цитата:

а что подразумевается под "номер первой колонки" "номер второй колонки"?

sun888
поздразумевал, что у Вас в одном столбце встречается "0" а в другом - "#Н/Д"


Вот только я не рекомендую пользоваться этим макросом!!!
1) он просто не рабочий!!!!!!
2) зачем перебирать 10000 строк!??! до последней использованной строки вполне достаточно будет.
например так:
Код:
Sub WithErrorCells()
Dim n1, n2, i, MaxRow As Long
n1 = 2 'номер колонки, где прописаны формулы ВПР (где есть #Н/Д)
MaxRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To MaxRow
If IsError(Cells(i, n1)) Then
With Range(Cells(i, 1), Cells(i, 10)).Interior
.ColorIndex = 3 'Красный цвет'
.Pattern = xlSolid
End With
End If
Next i
End Sub

Цитата:

Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
--------------------------------------------------------------------------------
Nickolasha

Цитата:а что подразумевается под "номер первой колонки" "номер второй колонки"?

sun888
поздразумевал, что у Вас в одном столбце встречается "0" а в другом - "#Н/Д"


Вот только я не рекомендую пользоваться этим макросом!!!
1) он просто не рабочий!!!!!!
2) зачем перебирать 10000 строк!??! до последней использованной строки вполне достаточно будет.
например так:
Код:
Sub WithErrorCells()
Dim n1, n2, i, MaxRow As Long
n1 = 2 'номер колонки, где прописаны формулы ВПР (где есть #Н/Д)
MaxRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To MaxRow
If IsError(Cells(i, n1)) Then
With Range(Cells(i, 1), Cells(i, 10)).Interior
.ColorIndex = 3 'Красный цвет'
.Pattern = xlSolid
End With
End If
Next i
End Sub



для удаления строчек с "#Н/Д" сделайте обратный цикл от MaxRow к 1
и вместо выделения цветом - удаление всей строки
Cells(i, 1).EntireRow.Delete

я должен подметить что в столбце встречается как 0 так и "Н\д"..... и прошу прощения но я совершенно незнаком с макросами... тем более я студент и привык к ctrl+C -> ctrl+v...
напишите пожалуйста макрос полностью...
заранее спасибо!

Цитата:

Doctor_Livsi
Цитата:Нужно получить при обращении к Картинке, в частности jpg , размер картинки, а имеено Height & Width

а поясните, пожалуйста, что означает конкретно фраза "при обращении к Картинке"?
Как это выглядит в коде на VBA? И какая задача вообще стоит? Есть имя файла JPG, нужно узнать высоту и ширину, чтобы указать при загрузке картинки? Или что надо то?


Добавлено:
Вот здесь - http://vbnet.ru/subscribe/showsubscribe.asp?id=25
нашёл Определение типа рисунка и его размеров
пойдёт?

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

SERGE_BLIZNUK
позновательные и прозрачные примеры, спасибо! очень многое узнал от вас, вы можно сказать мой учитель по VBA...

Добавлено:
Оптимизация! Есть ли явные рекоминдации по оптимизации кода, например избегать select и т.п. и где их можно почитать? а также как замерить производительность макроса? думаю что онсновным показателем должено быть время выполнения, а вторым возможно колл-во операций или шагов как по ф8..

vasiliy74

Цитата:

Не могу понять как писать переменные в формулах, например:

Запиши макрос, когда вставляешь формулу вручную на лист и посмотри результат в бейсике. Могу сказать, что со стороны Visual Basic существует свой синтаксис для формул в ячейки. Обрати внимание, в одном случае ставится запятая, как разделитель параметров, в другом - точка с запятой. Все названия функций в бейсике пишутся в английском эквиваленте. Если хочешь в самом коде использовать функции, которые используются в ячейках, то это надо делать так:

Код: Application.WorksheetFunction.Min(myRange)

nick7inc
снял вопрос, но непонял твой ответ,
записал так и заработало:
in_r.Cells(c1.Row, 1).FormulaR1C1 = "=IF(RC[-1]<>0,RC[-1]/SUM(R2C[-1]:R" & index - 1 & "C[-1]),0)"

Добавлено:
как определить переменная в коде, чётное значение или нет?

vasiliy74

Цитата:

как определить переменная в коде, чётное значение или нет?

Код: If myVariable Mod 2 = 0 Then
' четность
Else
' нечетность
End If

Почему Значение out_r выбирается не из листа Total_E а из того что было активно до запуска макроса, хотя out_r1 выбирается не смотря на это строго из Totol_E?


Код: With Worksheets("Total_E")
Set start_cell = .Cells(1, "O")
Set out_r1 = Range(start_cell.End(xlDown).Offset(3, 0), start_cell.End(xlDown).Offset(65000, 0))
Set out_r = Range(Cells(start_cell.End(xlDown).Row + 3, "B"), "B65000")
End With

vasiliy74

Цитата:

Почему Значение out_r выбирается не из листа Total_E а из того что было активно до запуска макроса, хотя out_r1 выбирается не смотря на это строго из Totol_E?

потому что, еще раз говорю
Цитата:

если уж стремиться к изучению языка, то ... можно было поинтересоваться что за конструкция такая With ... End With, прежде чем использовать ее не к месту, в том числе и понимание кода затрудняя...

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


Цитата:

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

можешь вот тут почитать. есть интересные мысли.



Добавлено:
Так же нужно стараться не применять тип Variant (переменные занимают больше памяти), ограничивать область видимости переменных...
Очень хорошо об оптимизации кода написано у Рода Стивенса в книге "Visual Basic. Тестирование и отладка программ". Многое можно отнести и к VBA.

помогите если можете...

хочу заняться удалением лишних строк и столбцов...
допустим есть у меня масив данных 8 столбцов на 500 строк
а над ним или слева от него есть ячейки с какими то данными
как сделать так что бы этот масив переместился в ячейку А1 а все остальное просто удалить?

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

LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

For r = LastRow To 1 Step -1
Application.ScreenUpdating = False
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
For k = LastColumn To 1 Step -1
Application.ScreenUpdating = False
If Application.CountA(Columns(k)) = 0 Then Columns(k).Delete
Next k

dummy84
1)
Цитата:

Application.ScreenUpdating = False

Делать это в цикле - только сильно замедлять работу.
Сделайте один раз в начале макроса
и не забудьте в конце макроса, после всех действий
Application.ScreenUpdating = True

2) я вижу что вы пытаетесь удалить данные...
Только CountA(..) считает ПУСТЫЕ ячейки... т.е. Вы будете удалять ТОЛЬКО пустые ячейки.

не проще ли создать новый лист
и одной командой скопировать туда начиная с A1 весь ваш диапазон
"из 8 столбцов на 500 строк" ?...

кто использовал ScreenUpdating для ускорения выполнения макроса?

Добавлено:
а так же Application.Calculation = xlCalculationManual а может ещё чего есть?

Добавлено:
эти две штуки просто в разы нереальные разы увеличели выполнение макроса!!! я очень доволен!

vasiliy74

Цитата:

ScreenUpdating для ускорения выполнения макроса

Главное не забыть вернуть назад. А так - да, ускоряет. А интересно, что будет, если до восстановления значения true макрос завершится по ошибке? Или завершит своё выполнение скажем END или EXIT (SUB/Function/FOR/DO/While)?


Цитата:

Application.Calculation

Это лучше не трогать, если не особый случай. У тебя не будут пересчитываться формулы.


Добавлено:
vasiliy74

Цитата:

Код:With Worksheets("Total_E")
Set start_cell = .Cells(1, "O")
Set out_r1 = Range(start_cell.End(xlDown).Offset(3, 0), start_cell.End(xlDown).Offset(65000, 0))
Set out_r = Range(Cells(start_cell.End(xlDown).Row + 3, "B"), "B65000")
End With

В "Set out_r1 = ..." данные берутся из листа, указанного в start_cell . With влияет только на ".cells()" и ".range()".
В строчке "Set out_r =" у тебя "Cells()" указывает на текущий лист (ты что-то забыл такое маленькое поставить...) , а также вторая ячейка твоего диапазона "B65000" тоже указывает на текущий лист, поскольку использован "Range()" без ссылки на книгу/лист. В общем, надо эту строчку переписать заново, так запутаться недолго.

Добавлено:
With у тебя влияет только на следующую за ним строку, а 2 другим на него наплевать.

Добавлено:
А ещё выполнение макроса ускоряется, когда ты избегаешь выделений и активаций (*.Select, *.Activate).

SERGE_BLIZNUK
Application.ScreenUpdating = False больше в цикл засовывать не буду спасибо,
а как мне скопировать этот диапазон? я просто частенько импортирую с нашего програмного обеспечения SAP в ексель таблицы с данными о платежах, структура импортированого листа такая что сначала идет заголовок таблицы, всякие значки валют и все такое, а вот только потом таблица и просто каждый раз величина диапазона разная и начинаеться он с разных ячеек, например в ячейке D10 или h30, ну допустим правый нижний угол диапазона я найду, а вот верхний левый не знаю как найти, ведь перед ним есть не пустые ячейки. Тоесть я хочу что бы макрос сам открывал этот файл и из него вытягивал эту таблицу и обрабатывал. Это конечно можно сделать и вручную, но так было бы приятней.
правда тут еще есть момент в верхнем левом углу таблицы содержиться текст "код валюты", можно ли как то привязаться к кординате этой ячейки и потом копировать этот диапазо как range(cells(левый верхний угол), cells(lastrow, lastcolumn))?
если кто-нибуть знает как это реализовать пожалуста помогите. Спасибо...

dummy84

Цитата:

копировать этот диапазо как range(cells(левый верхний угол), cells(lastrow, lastcolumn))

Если известны 2 диагональные ячейки, то можно сознать объект Range и его копировать.
Здесь есть пример копирования.

Добавлено:
Если source объект типа Range, то можно написать:

Код:
set source = Range( SomeWorksheet.cells(r1,c1), SomeWorksheet.cells(r2,c2))

dummy84
nick7inc
а ещё быстрее (и удобнее) будет копирование не через буфер, а через метод диапазона Range (кусочек - пример из другого кода, поэтому на i и j внимания не обращаем ;-)))
Set w1 = ThisWorkbook.Worksheets("Work") 'Nazvanie lista, na kotorom vvodatsay dannye'
Set w2 = ThisWorkbook.Worksheets("DB") 'Nazvanie lista, kuda budem kopirovat'
w1.Activate
...
Range(Cells(i, 1), Cells(i, 10)).Copy w2.Cells(j, 1)


Добавлено:

dummy84

Цитата:

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

Так находите (хоть поиском, хоть перебором ) ячейку с текстом "код валюты",
правый нижний угол, по Вашим словам, Вы уже умеете искать,
а потом
Range( Cells(<левый верхний угол>), Cells(<правый нижний угол>).Copy <КудаКоп-ть>

Каким образом реализовать такую задачку:

Есть лист1 в котором столбец а содержит фамилия_имя_отчество
Каким образом заставить UserForm в поле для ввода текста подставлять возможные фамилия_имя_отчество из столбца A:A?
Что то подобное происходит при наборе имени адресата в Outlook. Если фамилия меня устраивает (Я набрал всего две-три буквы) я жму CommandButton1 и в ячейку A1 на Лист2 подставилась фамилия_имя_отчество целиком.

VBA только начал изучать, осваиваю запись макросов )))

Ладно, фиг с ней, с автоподстановкой...

Вопрос 2:
Создается база данных, в которую очередной строкой записываем данные из формы после нажатия кнопки ввод. Но для начала считаем непустые строчки
Sub FormsRun()
Dim r As Range ' где у нас последняя заполненная строчечка в столбце А:А ?
Set r = Range("A:A")
конец = (r.Columns.End(xlDown).Address)
UserForm1.Show ' идем выполнять форму
End Sub

Тупо данные занести в указанные ячейки можно так:
Private Sub CommandButton2_Click()
Range("A2").Value = UserForm1.TextBox1.Text
Range("C2").Value = UserForm1.Calendar1
Range("D2").Value = UserForm1.CheckBox1
Range("E2").Value = UserForm1.OptionButton5
Range("F2").Value = UserForm1.OptionButton4
Range("G2").Value = UserForm1.ListBox1
End Sub

Отсюда вопрос: Как обозвать ячейку для записи в столбце А и строкой "конец+1" ? (собственно какой синтаксис для такой команды)

Вопрос 3:
Как данные из ListBox вставить в ячейки? меня в ListBox пять столбцов и если я пишу:

Range("G2").Value = UserForm1.ListBox1' то естественно у меня в ячейку G2 вставляется только из первого столбца ListBox. Может через запятую? Сейчас попробую.

Пока все.

Добавлено:
Нет. через запятую в указанные ячейки вставляется одно и тоже значение первого столбца ListBox/

Добавлено:
И еще вопрос 4:
Как заставить TextBox писать не в одну строчку, а переносить слова?

CEMEH
ответ на Вопрос 2) каждый раз по нажатию кнопки определяйте последнюю ячейку в столбце и заполняйте от неё

Цитата:

Private Sub CommandButton2_Click()

Ваш код вернёт объект типа Range (грубо говоря ссылку на ячейку), причём это не
последняя использованная, а первая после пустой - если в столбце A есть пустоты - будут проблемы ;-))
Мне больше нравится такой вариант определения последней занятой строки
' Определить число используемых рядов:
nr = ActiveSheet.UsedRange.Rows.Count
' Прыгаем вверх до последней заполненной ячейки:
lastrow = Cells(nr,col).End(xlUp).Row
' где col - номер нужного столбца

т.о. можно использовать код
Private Sub CommandButton2_Click()
Dim Lastrow as Long
lastrow = Cells(ActiveSheet.UsedRange.Rows.Count,1).End(xlUp).Row
дальше уже совсем просто:
Cells(LastRow + 1, "A").Value = UserForm1.TextBox1.Text
Cells(LastRow + 1, "C").Value = UserForm1.Calendar1
....
Правда, Вас подстерегает одна засада! Вы определяете последний занятый ряд в столбце A - а пишете в столбцы C, D, E, F, G ... а там может быть больше строчек занято, чем в столбце A
впрочем, это Ваше дело...

полуответ на Вопрос 3)
никогда не работал с элементами управления... сорри... %-(( но кое-что скажу, куда копать - а дальше Вы уж сами!
если у Вас пять столбцов, то как Вы хотите их вставить в ОДНУ бедную ячейку G2 ?!
всё значения через запятую?!
ну, можете использовать такой код
Dim AllListBox As String
Dim i as Integer
AllListBox = ""
For i = 0 To ListBox1.ColumnCount - 1
AllListBox = AllListBox & "," & ListBox1.Column(i)
Next i
Cells(2, "G").Value = AllListBox

SERGE_BLIZNUK
По ответу 2
Поиск следующей пустой строки
У меня создается таблица - некая база данных. При очередном занесении в базу данных (заполняется в строку) ячейки в столбце A:A будут заполнятся обязательно (отсальные в строке не все и не всегда) Если вдруг появляется пустая ячейка в A:A(удалял из базы данных ранее) то ничего страшного - пусть пишет в эту строку. Разумеется вычислять последнюю не пустую строку надо каждый раз по щелчку CommandButton2 (вычисляем пустую, заносим данные).

Сейчас буду пробовать ваш совет. Спасибо огромное.


пс
Сильно не пинайте, я сегодня второй день как программист )))

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