» Excel VBA (часть 3)

sHTML не пустая. теги есть.
почему же если паузу ставлю, то все работает?... странно

Нужна программка или лист Excel с
формулами для следующей задачи.
Даны данные:
дата
время начала следственного
действия
время окончания следственного
действия
вид следственного действия
ФИО злодея
ФИО сотрудника
ФИО защитника
Задача:
выявление всех пересечений.
например, чтобы не получалось,
что один сотрудник проводит
разные действия в одно и тоже
время или защитник одновременно
присутствует при проведении СД у
разных сотрудников, и т.д.
Пример листа Excel здесь http://
ifolder.ru/21321948

Люди,помогите!!!горю!напишите код к даной проге.
Для каждой из матриц А(5,5) и В(6,6)измените местоположение элементов на главной и побочной диагонали
Заранее спасибо!

Салют джентльмены. Тут устроился на новую работу, и в ближайшие пол года мне наверное придется часто парсить различные логи. Придется учить VBA. Хотя надпись в шапке: "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" - отчасти отражала мое отношение к этому вопросу еще месяц назад.

Суть такая. Ручками я более или менее научился кое что делать в сортировке. Но вот VBA пока ставит в тупик. К примеру:
мне нужно отсортировать значения: получится что-то вроде:

Цитата:

=====>Start working on range Range: [10.87.86.254 - 10.87.86.254]
=====>Start working on range Range: [10.87.92.254 - 10.87.92.254]
=====>Start working on range Range: [10.87.95.254 - 10.87.95.254]
-->Result Collected IPs in range: array(['10.65.207.190', '10.65.207.190'], java.lang.String)
-->Result Collected IPs in range: array(['10.65.207.62', '10.65.207.62'], java.lang.String)
-->Result Collected IPs in range: array(['10.65.32.254', '10.65.32.254'], java.lang.String)

нужно понять на какой строке начинает текст "-->Result" и удалить все что выше него.

Записанный макрос сделал это удаление как то так:

Код: ActiveWindow.SmallScroll Down:=300
Rows("1:320").Select
Range("A320").Activate
Selection.Delete Shift:=xlUp

Господа, помогите дельным советом, сам я в VBA почти чайник
В общем составил я вот что:


Код: Sub Ïîèñê_â_Äèàïàçîíå()
Dim i, j, t As Integer
For i = 4 To 5000
If Mid(Cells(i, 2), 1, 1) <> "!" Then
j = 5
If Cells(i, 2).Value Like "*&#224;)*" Then
t = i
Cells(t, j) = Trim(Mid(Cells(i, 2), 3, Len(Cells(i, 2))))
End If
If Cells(i, 2).Value Like "*&#225;)*" Then
Cells(t, j + 1) = Trim(Cells(i, 2))
End If
If Cells(i, 2).Value Like "*&#226;)*" Then
Cells(t, j + 2) = Trim(Cells(i, 2))
End If
If Cells(i, 2).Value Like "*&#227;)*" Then
Cells(t, j + 3) = Trim(Cells(i, 2))
End If
If Cells(i, 2).Value Like "*&#228;)*" Then
Cells(t, j + 4) = Trim(Cells(i, 2))
End If
If Cells(i, 2).Value Like "*&#229;)*" Then
Cells(t, j + 5) = Trim(Cells(i, 2))
End If
If Cells(i, 2).Value Like "*&#230;)*" Then
Cells(t, j + 6) = Trim(Cells(i, 2))
End If
End If
Next
End Sub

lypky

Цитата:

Какие есть варианты?

Например,так:

Код: Sub Main()
On Error Resume Next: Rows("1:" & [A:A].Find("-->Result").Row - 1).Delete
End Sub

Kolonit
Выложи Excel-файл.

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

Здравствуйте.
Изучаю VBA. Новичок. Помогите решить проблему. Задача следующая.
С одного рабочего листа(Расчётный_Итог) информация переносится на другой(Табель) с сохранением данных.
Затем на первом листе информация стирается для внесения данных для другого клиента,
а на втором листе (Табель) нужно, сохранив информацию об первом клиенте, перейти в следующий свободный столбец для заполнения данных для нового клиента. Использовал макросы для решения. Всё вроде получается, а как перейти в следующий свободный столбец не знаю. Конкретно информации по своему вопросу нигде не нашёл. Подскажите, как справиться с проблемой. Вот Макрос по переносу данных на лист Табель:

Sub Проба2()
'
'
'
Range("D4").Select
Selection.Copy
Sheets("Табель").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Расчётный_Итог").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Табель").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Расчётный_Итог").Select
Range("E11:E205").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Табель").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Расчётный_Итог").Select
Range("F206").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Табель").Select
Range("B202").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Расчётный_Итог").Select
Range("O206").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Табель").Select
Range("B203").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Расчётный_Итог").Select
ActiveWindow.SmallScroll Down:=-198
End Sub

Нужно, чтобы после заполнения курсор перешёл в следующий свободный столбец и процесс повторился. Заранее благодарен.

UserAtta

Цитата:

Нужно, чтобы после заполнения курсор перешёл в следующий свободный столбец и процесс повторился.

1. Активировать лист и ячейку для того, чтобы вставить значение вовсе не нужно.
2. До каких пор повторять процесс копирования данных с одного листа на другой?
3. Ваш макрос можно (нужно) существенно оптимизировать. Например, так:

Код: Sub Проба2()
Application.ScreenUpdating = False: Sheets("Расчётный_Итог").Activate
With Sheets("Табель")
.[B4] = [D4]: .[B5] = [D5]: .[B202] = [F206]: .[B203] = [O206]
[E11:E205].Copy: .[B6].PasteSpecial Paste:=xlPasteValues
End With
End Sub

друзья, подскажите пожалуйста как внутри цикла и внутри оператора if если значение, попустим, истина оператор перехода автоматически переходил на следующую переменную цикла, в данном случае, на следующую i

ну что-то типа такого, тока это не работает


Код: Dim i As Integer
For i = 15 To 7500
If Not IsEmpty(Cells(i, 1)) Then goto next i
Else: Cells(i, 1) = "yes"
End If
Next

Kolonit
А может упростить условие
Если ячейка не пустая - пишем yes
Если пустая - ничего не делаем и переходим на следующий i:


Код: Dim i As Integer
For i = 15 To 7500
If IsEmpty(Cells(i, 1)) Then
Cells(i, 1) = "yes"
End If
Next

Цитата:

А может упростить условие
Если ячейка не пустая - пишем yes
Если пустая - ничего не делаем и переходим на следующий i:

я задал вопрос на примере сильно упрощенной задачи, в реальности все несколько сложнее, я просто хотел узнать как корректно задать безусловный переход внутри цикла и внутри if, чтобы перешлось на следующую i (на следующую переменную цикла)

а ещё подскажите пожалуйста: допустим задано такое условие

Цитата:

If Cells(1, 1).Value Like "корень"

, т. е. если ячейка сдержит искомое слова, либо комбинацию символов то...

А как задать подобным образом условие: "Если ячейка не содержит заданное слово либо комбинацию символов"?

Kolonit

Цитата:

ну что-то типа такого, тока это не работает

Код: Sub aaa()
Dim i As Integer
For i = 15 To 7500
If Not IsEmpty(Cells(i, 1)) Then
GoTo Lab1
Else
Cells(i, 1) = "yes"
End If
Lab1:
Next
End Sub

Kolonit

Цитата:

А как задать подобным образом условие: "Если ячейка не содержит заданное слово либо комбинацию символов"?

Вместо
Код: If Cells(1, 1).Value Like "корень" Then...

Всем огромная благодарность спасибо за помощь

На листе "Лист1" есть 2 сгруппированных объекта OptionButton.
Как програмно менять их значение (OptionButton.Value) из внешнего модуля? Т.е. не из модуля листа "Лист1".
При просмотре коллекции Worksheets("Лист1").OLEObjects
OptionButton отсутствует в списке членов коллекции.

У меня куча гиперссылок в вложеной папке типа "записи\KS Nokia\2010\01\20100121-174124-973983535.amr"
После неудачного сохранения стало "C:\Documents and Settings\Яциків\Application Data\Microsoft\Excel\записи\KS Nokia\2010\01\20100121-174124-973983535.amr"

Подскажыте как можно во всех гиперссылках удалить "C:\Documents and Settings\Яциків\Application Data\Microsoft\Excel\"

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


Добавлено:
Вопрос не в имени гиперссылки, а в адресе

Добавлено:
Я могу написать макрос, если подскажыте как значению ячейки2 присвоить значение адреса гиперссылки ячийки1. Дальше найду позицыю "записи". Урежу значение ячейки 2. И дальше надо подсказку как значению гиперссылки ячейки1 присвоить урезаное значение, что будет находится в ячейке2.

Если это вариант?

HELP me PLEASURE...

Есть, с гиперссылками надо работать через объект HyperLinks. Например, если нужно добавить гиперссылку, используешь конструкцию

Код: HyperLinks.Add Cells(1,1), "здес_будет_адрес", "здесь_допадрес", "здесь поясняющий текст"

Цитата:

[/q]
[q]2. До каких пор повторять процесс копирования данных с одного листа на другой?

Здравствуйте.
Выделенные ячейки в макросе переносятся на лист Табель для каждого клиента. Заходит клиент. Заполняется расчётный лист и данные с него считываются на лист Табель. Затем расчётный лист очищается и заполняется для следующего клиента. Может кнопки построить? И связать макрос заполнения и макрос очистки с кнопками?

Здраствуйте ещё раз
Вы мне помогли.
Как редактировать гиперссылку я разобрался но столкнулся с проблемой
когда в ячейке её нету выбивает ошыбку Run-time error"9": Subscript out of range
Может поскажыте как проверять наличие гиперссылки, а то я по английски не спец и хелпером не понимаю

VladimirKataliz
If Cells(1, 1).Hyperlinks.Count > 0 Then MsgBox Cells(1,1)..Hyperlinks(1).Address

Спасибо, ZlydenGL AndVGri
Работает
Может комуто пригодитса
изменить адреса гиперссылок после автосохранения и утери оригинал файла
змінити адреси гіперссилок

Sub hyperlink()
Sheets("11").Select
Dim I_0, K_n, J, IK, NKa As Integer
Dim no, no1, Te As String
I_0 = 1
NKa = 6619 ' останній № по рядкам
For IK = I_0 To NKa ' цикл по рядкам
For J = 1 To 50 ' по стовбчикам
If Cells(IK, J).Hyperlinks.Count > 0 Then 'проверять наличие гиперссылки
no = Cells(IK, J).Hyperlinks(1).Address ' читаем
Te = InStr(1, no, "записи", vbTextCompare) 'позиція в адресі папки "записи"
K_n = Len(no) ' довжина адреси
Cells(IK, 63) = Right(no, K_n - Te + 1) ' обрізаєм адрес
no1 = Cells(IK, 63) '
Cells(IK, 63).Clear
Cells(IK, J).Hyperlinks(1).Address = no1 ' присвоюєм обрізаний адрес
Else: GoTo Line3579 ' якщо нема гіперссилки
End If
Line3579:
Next J
Next IK
End Sub

Написал программу с заполнением огромной формы , имеющей поля ввода TextBox.
Не могу, однако, в некоторые поля ввода ввести информацию правой кнопкой "мышки", используя Windows-ское контекстное меню (копировать-вставить).
Помогите
Спасибо

Всем привет.
С excel я работаю довольно часто, но макросами никогда не интересовался особо, ввиду ненадобности ... но вот вдруг приперло ... пробовал найти выход с помощью формул, но не вышло .... посему оказался здесь Итак проблема :
В приаттаченном документе .xls нужно, чтобы в колонке "final calls" в колонке "level" писались уровни от большего к меньшему, которые находятся в колонке "level CALL", при условии, что общая сумма "Size" для этих уровней во всём документе была >=1, а соответственно в колонке "size" отражалась эта общая сумма (например level1,3798 - size500, level 1.3647 - size200 значит на уровне 1,3798 накопилось 500 size на протяжении всего документа, а на уровне 1.3647 накопилось 200 size.)
А в колонке "final puts" аналогично, но только для уровней, находящихся в "level PUTS".
Ребят, с макросами у меня напряжёнка, поэтому буду очень благодарен, если поможете написать. Если что-то непонятно написал - спрашивайте. Заранее спасибо !
Документ : http://zalil.ru/30455611

Задача делать выборки из файла dbf. Нашёл в описании функцию SQLExecQuery. Пробую прокомпилиривоть приведённый в описании пример. Выдаётся ошибка Sub or Function not defined.
Что делать?

KolyaP
Подключи Xlodbc.xla add-in
А лучше используй ADO, DAO, (как советует документация по функции SQLExecQuery )
Можешь записать макрорекордером использование источника данных Microsoft Query или ему подобных с последующей редакцией под свои нужды.

Помогите, пожалуйста.
Нужно как то, чтобы находились одинаковые числовые значения (повторы) в столбце, допустим C.
Например, вот допустим список на 900 чисел:
4156420011223344
4156420045454545
4156420011223344 - чтобы этот повтор как-то отобразился.
Заранее спасибо за помощь

Kiljes
Не совсем понятно

Цитата:

чтобы этот повтор как-то отобразился

Попробуй так
[more]

Код:
'Параметры
'onSheet - рабочий лист с таблицей
'dataCol - столбец, котором есть повторяющиеся числа
'outCol - столбец вывода результата
'firstRow - строка начала данных
'lastRow - строка конца данных
'Описание
'Метод записывает одно и тоже число для всех повторяющихся чисел
'уникального числа в столбце данных.
'Уникальным в повторе принимается верхнее число.
'Если у числа нет повторов, то оно в столбце результата не
'помечается. Каждое уникальное число с повтором имеет свой номер.
Public Sub MarkDup(ByVal onSheet As Excel.Worksheet, _
ByVal dataCol As Long, ByVal outCol As Long, _
ByVal firstRow As Long, ByVal lastRow As Long)
Dim vData As Variant, vOut() As Variant, isNotMark As Boolean
Dim i As Long, k As Long, tmpVal As Double, vMark As Long

vData = onSheet.Range(onSheet.Cells(firstRow, dataCol), onSheet.Cells(lastRow, dataCol)).Value
ReDim vOut(LBound(vData, 1) To UBound(vData, 1), 1 To 1): vMark = 0
For i = LBound(vData, 1) To UBound(vData, 1) - 1
If (VBA.IsEmpty(vOut(i, 1))) And VBA.IsNumeric(vData(i, 1)) Then
tmpVal = CDbl(vData(i, 1)): isNotMark = True
For k = i + 1 To UBound(vData, 1)
If VBA.IsNumeric(vData(k, 1)) And VBA.IsEmpty(vOut(k, 1)) Then
If CDbl(vData(k, 1)) = tmpVal Then
If isNotMark Then isNotMark = False: vMark = vMark + 1: vOut(i, 1) = vMark
vOut(k, 1) = vMark
End If
End If
Next k
End If
Next i
onSheet.Range(onSheet.Cells(firstRow, outCol), onSheet.Cells(lastRow, outCol)).Value = vOut
End Sub

AndVGri
Например, вот допустим список на 900 чисел:
1. 4156420011223344
2. 4156420045454545
............................
50. 4156420011223344 и тут вдруг это значение повторяется и нужно, чтобы этот повтор как-то отобразился.
А как обозначать столбцы? Допустим мне нужно проверить столбец C. Куда вписывать?

И вот ещё. Как создать графический интерфейс (форму) к такой строке макроса:
FindRange = Range("C810:C968"), где C - это столбец, он постоянный, а вот числа 810 и 968 обозначают значения строк, в данном случае с 810 по 968. Я их часто изменяю.