» Excel VBA (часть 3)

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

WingfirE

Наврядли есть такой универсальный макрос. Каждый пишет под свои задачи/условия.

Sub Q()
Dim i, j, icol, irow As Integer

icol = ActiveWorkbook.ActiveSheet.UsedRange.Columns.Count
irow = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count

j = 1
While j < irow
i = 1
While i < icol
........
ActiveWorkbook.ActiveSheet.Cells(i, j).Value = Str(i) & Str(j)
i = i + 1
Wend
j = j + 1
Wend


End Sub

WingfirE
Есть разница, пробегать весь рабочий лист либо часть его с заполненными ячейками, по моему Вам нужно как раз последнее. Если так, то можно использовать параметр
UsedRange

Dim r As Range

For Each r In Worksheets("Лист1").UsedRange

' проверка
Next

если нет, то .UsedRange заменим на диапазон с последней ячейкой листа

См. здесь.

Есть интересный сайт про Excel - www.excel-eto-prosto.ru

RJ992
Извините, и что в нем интересного?

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

Цитата:

В экселе по моему нет разницы, сравнить к-во строк в одной книге либо в разных.
Путь только нужен ко второй, либо имя и перебором ее найти.
Попробуйте так:

ругается на неподдерживаемый метод
http://joxi.ru/Y6_jUdg5CbCuR9Sf3Zw

UPD: сорь, у меня столбец А пустой в файле ) сейчас попробую поправить

на B тоже вылетает, есть утилиты внешние, но оч медленно както сравнивают файлы

elite128
Посмотрите пример тут:
http://rghost.ru/47442311

Добавлено:
Vasyatka91
Занесите в массив все значения базовых станций и пройдитесь циклом по ним:
Dim aPar$()

aPar=split(UserForm1.TextBox1.Value,",")
For i=0 to ubound(aPar)
par =aPar(i)

и так далее

Добавлено:
elite128
Что бы не привязываться к столбику, попробуйте найти последнюю строку так:
lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

andrewkard1980
это сделал, работает отлично, спасибо! но вот еще такой вопрос:
вот у меня есть таблица в ней указанны данные всякие, и есть ячейка в которой указаны ячейка в которое надо скопировать эти данные в шаблон, но таких ячеек не одна а штук 25 ну вообщем на каждые данные, как это можно реализовать.

вот тут пример, там подробнее изложено
http://rghost.ru/47452377

Vasyatka91
В переменной par мы получили номер необходимой строки, теперь пишем:

With Worksheets("Лист2")
' *NodeB name
.[B4]=Cells(par,1)
.[F87]=Cells(par,1)
.[G89]=Cells(par,1)
.[C94]=Cells(par,1)
.[C160]=Cells(par,1)
' *NodeB ID
.[C4]=Cells(par,2)

' и так далее для всех ячеек. Т.е. нужно прописать их полностью.

Еnd with

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

Добавлено:
в принципе я сделал так, оно работает:
Dim q$()
q = Split(Range("A1"), ",")
For k = 0 To UBound(q)
Next
но делать этот цикл для каждой ячейки тоже долго и будет много переменных около 30, вот как нибудь универсальные его сделать нельзя, или как нибудь функцию, а потом обращаться к ней,(если нельзя то придется делать так для каждой ячейки)
ну вот теперь нам известны ячейки в которые нужно вставить имя допустим "база"(p1).
то есть слово "база"(p1) должно скопироваться (вставится), в ячейки которые мы выделили с помощью цикла.
раньше было так 'Range("B4,C167").Value = p1, а как вот сделать щас не знаю, как то так q(k)=p1 или p1=q(k) не получается

Vasyatka91
Ясно, попробуйте так:

p1=range(q(k))

Добавлено:
Vasyatka91
Функция не ускорит Ваш код, а сделает его более читабельным что ли, и я не думаю, что с 30 переменными у Вас будут проблемы по скорости выполнения кода.

andrewkard1980
все сделал, все работает идеально, даже быстрее щас думает секунды 3 а раньше 30
СПАСИБО ВАМ ОГРОМНОЕ ЗА ПОМОЩЬ!!!!!

Доброго дня всем!
Есть 1000 книг каждого из сотрудников(личные карточки). В каждой книге нужно заменить дату с 2011-2012гг на 2012-2013 в конкретной ячейке без открытия файла. Дату в своё время ввели неправильно и открывать и править каждую книгу очень долго. Если нет такого решения, то придётся править вручную. Думаю объяснил доходчиво. Заранее благодарен!

slavjanin
пробуйте так:

Код:
Sub ChangeDate()
Dim oFS As Object, oFl As Object
Dim oWb As Workbook
Dim dDate As Date

Set oFS = CreateObject("scripting.filesystemobject")
Set oFS = oFS.getfolder(ActiveWorkbook.Path)
Application.ScreenUpdating = False

For Each oFl In oFS.Files
If oFl.Name <> ThisWorkbook.Name Then
Set oWb = Workbooks.Open(oFl)
dDate = oWb.Worksheets(1).[A1].Value
dDate = Day(dDate) & "." & Month(dDate) & "." & Year(dDate) + 1
oWb.Worksheets(1).[A1] = dDate
Application.DisplayAlerts = False
oWb.Save
oWb.Close
Set oWb = Nothing
End If
Next
Set oFS = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

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

Цитата:

я ставлю знак + и вся строка заливается зелёным цветом.

Это скорее условное форматирование вам поможет, в VBA от "ставлю плюс" строка не закрасится.

CBuH2008
в модуль листа:

Код: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [H:H]) Is Nothing Then
If Target.Value = "+" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Interior.ColorIndex = 3
End If
End If
End Sub

Здравствуйте.
Есть таблица, в которой забиваются данные по месяцам. Кварталы, 1 полугодие, 9 месяцев, год формируются сами (суммируются данные при заполнении месяцев). Но возникла необходимость во вотором полугодии. Помогите, пожалуйста, доработать макрос, чтобы формировалось еще и второе полугодие.
Прикладываю файл http://rghost.ru/47725814

Leojse
А в чем проблема? Чужой макрос не трудно доработать - но времени на его разборку затрачивается уйма, сузьте запрос, попробуйте разобраться сами и напишите конкретную просьбу - напр. как сделать что бы ячейка А1 содержала формулу такую то.

добрый день.

Есть файл из которого разным форматом печатаются стикеры.
можно вбить любой символ в первый столбец, либо проставить необходимое количество в последний, либо в зеленое поле вбить значение баркода.
раньше поле состав было более или менее одинаковое и размер шрифта был стандарный 5 пт, сейчас появились более длинные составы, поэтому для них нужно использовать меньший шрифт.
Нужно в то что есть добавить макрос который бы смотрел на количество символов в столбце с составом и если там менее 26 символов, тогда шрифт 6пт, если 26-30 тогда 5пт, если больше то 4пт.

Подскажите пож-та, как задать такое условие.

Заранее благодарна.

shune4ka
Доброе время суток - дайте доступ к файлу для более точной настройки макроса.

Сделала

shune4ka
Вот Ваш макрос:

Код: Sub ChangeFontSize()
Dim l&
Dim oWsh As Worksheet

Set oWsh = ThisWorkbook.Worksheets("Таблица")
For l = 4 To oWsh.Cells(oWsh.Rows.Count, "F").End(xlUp).Row
Select Case Len(oWsh.Cells(l, 6))
Case Is < 26
oWsh.Cells(l, 6).Font.Size = 6
Case 26 To 30
oWsh.Cells(l, 6).Font.Size = 5
Case Else
oWsh.Cells(l, 6).Font.Size = 4
End Select
Next
Set oWsh = Nothing
End Sub

andrewkard1980
Спасибо.
Видимо я не совсем верно объяснила проблему.
В книге есть 4 скрытых листа с формами для печати. И текст из столбца F вставляется в определенное место в них.
Т.е. на листе Таблица, мне не нужно ничего менять, а вот когда из этого столбца информация попадает в форму для печати, как раз и нужно менять размер шрифта, чтобы поле было занято как можно лучше.

Еще раз спасибо и сорри за неверное толкование задачи)

Пробуйте так:

Код: Sub ChangeFontSize()
Dim l&, s&

For s = 1 To ThisWorkbook.Sheets.Count
Select Case ThisWorkbook.Worksheets(s).Name
Case "new_45"
With ThisWorkbook.Worksheets("new_45")
Select Case Len(.Cells(5, 4))
Case Is < 26
.Cells(5, 4).Font.Size = 6
Case 26 To 30
.Cells(5, 4).Font.Size = 5
Case Else
.Cells(5, 4).Font.Size = 4
End Select
End With
Case "45x45"
With ThisWorkbook.Worksheets("45x45")
Select Case Len(.Cells(4, 4))
Case Is < 26
.Cells(4, 4).Font.Size = 6
Case 26 To 30
.Cells(4, 4).Font.Size = 5
Case Else
.Cells(4, 4).Font.Size = 4
End Select
End With
Case "size_45"
With ThisWorkbook.Worksheets("size_45")
Select Case Len(.Cells(4, 4))
Case Is < 26
.Cells(4, 4).Font.Size = 6
Case 26 To 30
.Cells(4, 4).Font.Size = 5
Case Else
.Cells(4, 4).Font.Size = 4
End Select
End With
Case "50x80"
With ThisWorkbook.Worksheets("50x80")
Select Case Len(.Cells(4, 4))
Case Is < 26
.Cells(4, 4).Font.Size = 6
Case 26 To 30
.Cells(4, 4).Font.Size = 5
Case Else
.Cells(4, 4).Font.Size = 4
End Select
End With
End Select
Next

End Sub

shune4ka
перед тем, как прогнать макрос, снимите защиту листов.

andrewkard1980

все получилось)) Огромное спасибо.

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