» Excel VBA (часть 3)

andrewkard1980, про InStr Вам уже сказали, единственное замечу, что для такой работы лучше регулярных выражений не придумали ещё ничего

Спасибо.
InStr не годится, потому что он привязывается к символу "/" и повторению, то например с первой строки число перед третим слешем будет 49, в второй - 48, в третей - л, что не есть хорошо. Я подразумевал поиск именно /**/ и уже от него плясать. Например в Excel я использую формулу:
=MID(G14;FIND(" ";G14;SEARCH("/??/";G14;1)-6);SEARCH("/??/";G14;1)-FIND(" ";G14;SEARCH("/??/";G14;1)-6))

Undaster

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

andrewkard1980, рекомендую RegexBuddy в качестве конструктора регулярных выражений — голову не заменяет, но жизнь сильно упрощает.

Undaster
интересная штука, но мне надо в макросе.

asbo
А функция InStr может иметь вид как SEARCH("/??/";G14;1)? Под знаками вопроса - любые числа.

KolyaP
Может на Планета Excel? Там и народу больше тусутется
andrewkard1980
А кто мешает пользоваться функциями Excel в VBA? Через

Код:
Dim xlFuncs As WorksheetFunction
Dim sValue As String, sResult As String
Set xlFuncs = Application.WorksheetFunction
sValue = Range("G14").Value
'sResult = Mid$(sValue, xlFuncs.Find(" ", sValue ......

Т.е. требуется обнаружить конструкцию, типа "??/??/??" и получить первое в ней число?
Можно, например, так:

Код: s = "Ахматової серія КТУ, 19/25кер/бет, 49/19/12, стяжка, с/в сумісний, балкон, розвинена інфраструктура, 80000у.о., код 2130"
On Error Resume Next
MsgBox Split(Mid$(s, Application.Search("??/??/??", s)), "/")(0)

SAS888
Отличное решение, я не встречал еще Application.Search. Возьму на вооружение.
Спасибо.

Добавлено:
SAS888
Сделал код в таком ввиде:
z19 = Application.Search("??/??/??", z16)
z20 = Application.Search("??/????/??", z16)

If IsNumeric(z19) Then z21 = z19 Else z21 = z20
If IsError(z21) = True Then z22 = "" Else z22 = Split(Mid$(z16, z21), "/")(0)

If z22 < 1 Then z23 = Split(Mid$(z16, z21 - 3), "/")(0) Else z23 = z22

Таким образом получается вытянуть значения типа
57/25/14
46/18.2/13.2
46.6/18.2/
Т.е. практически все возможные, что есть хорошо
Если не делать проверку на Error, при ошибке ставит предидущее значение.
Еще раз спасибо за подсказку SAS888

Помогите выделить столбцы с определенным именем.
Необходимо макросом скопировать на отдельный лист столбцы с определенными именами…
Имена столбцов в первой строке... , пробовал через Range с указанием имени столбца – нифига не вышло. В VBA далеко не силантий.
Заранее спасибо.

Columns("E:M").Select

Цитата:

пробовал через Range с указанием имени столбца – нифига не вышло.

Почему? Вот варианты:

Код: Range("E:M").Select
[E:M].Select
Columns("E:M").Select

В том-то и есть трудность: номера столбцов, необходимые для копирования не известны. Определить их нужно по имени. (К примеру необходимо копировать столбцы с именем "/ESADout_CU:ESADout_CUGoodsShipment/ESADout_CU:ESADout_CUGoods/#id", "/ESADout_CU:ESADout_CUGoodsShipment/ESADout_CU:ESADout_CUGoods/catESAD_cu:CustomsCost" и т.д.). Имена столбцов известны.

Ну тогда так?

Код: Dim Col as Byte
For Col = 1 To Cells.SpecialCells(xlCellTypeLastCell).Column
If Cells(Col) Like "*точтоищем*" Then
Columns(Col).Copy
Destination.Paste
End If
Next Col

Прошу помочь с задачкой: нужно несколько txt-файлов (таблицы) вставить последовательно в один документ Excel.
Нашел в сети вот это

Код: SUB Макрос1()
b = Dir("*.TXT")
i = 1
WHILE b <> ""
With Selection
.InsertFile FileName:=b, ConfirmConversions:=False
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
END With
i = i + 1
b = Dir()
IF i MOD 2 = 0 THEN
Selection.InsertBreak TYPE:=wdSectionBreakNextPage
END IF
WEND


END SUB

Добрый вечер, коллеги.
Столкнулся со сложностью,
есть html страничка в виде:
http://www.n.com/index.php?id=40&file=01.txt ' Пример
открывается как обычный сайт, но процедура не работает, подскажите как видоизменить?

код:
sURI = "http://www.n.com/index.php?id=40&file=01.txt"
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp Is Nothing Then
Exit Sub
End If
oHttp.Open "GET", sURI, False
oHttp.Send
htmlcode = oHttp.responseText

Добавлено:
Поспешил с вопросом. Нашел, спасибо. Решение вот:
Set IE = CreateObject("InternetExplorer.Application"):
On Error Resume Next
addr$ = "http://www.......file=01.txt"
IE.Navigate addr$
While IE.busy Or (IE.readyState <> 4): DoEvents: Wend
txt$ = IE.Document.body.innerText
z = txt$

ZlydenGL
о! буду пробовать!

Если в текстовых ячейках помимо основного текста имеется краткий комментарий, заключенный в квадратные (или любые другие) скобки, то можно ли как-то удалить эти комментарии из всей колонки? Текст комментариев, естественно, в каждой ячейке разный.
Простая, на первый взгляд, задачка, но, похоже, стандартными средствами макрозамены не решается.
Спасибо!

Если без регекспа, то можно так:

Код: If Instr(1, Cells(I,J), "(", vbTextCompare)>0 Then
RemoveComment(Cells(I,J), "(")
ElseIf Instr(1, Cells(I,J), "[", vbTextCompare)>0 Then
RemoveComment(Cells(I,J), "[")
ElseIf Instr(1, Cells(I,J), "{", vbTextCompare)>0 Then
RemoveComment(Cells(I,J), "{")
End If

Private Function RemoveComment(MyStr As String, Start_Symbol as String) As String
Dim Start As long, Finish As Long
Start = Instr(1, MyStr, Start_Symbol, vbTextCompare)
If Start_Symbol = "(" Then
Finish = Instr(Start + 1, MyStr, ")", vbTextCompare)
Else
Finish = Instr(Start + 1, MyStr, Chr(Asc(Start_Symbol)+2), vbTextCompare)
End If
If Finish > Start Then
RemoveComment = Left(MyStr, Start-1) & right(MyStr, Len(MyStr) - Finish + 1)
Else
RemoveComment = MyStr
End If
End Function

ZlydenGL
Я жутко извиняюсь, но в описании задачи я неправильно использовал одно слово, что привело к полному искажению смысла просьбы. Поучительный пример, что выражаться надо точно.
Дело в том, что под "комментарием" я имел в виду не комментарий в специфическом смысле MS Excel, а просто обычный текст, который по смыслу является комментарием к основному тексту ячейки. Например, так:

Код: яблоки красные [у бабы Дуси не покупать!]
груши гнилые [опасно для здоровья!]

oshizelly, все правильно, мой код с такими записями и работает Коллекцию Comments() вообще не использую.

Только отладить не забудь - у меня так руки и не дошли этот код в VBA вставить да посмотреть на результат.

Может было, но напишу.
Добавил на панель кнопку, которая включает/убирает автофильтр в активной строке.

Код: Sub Автофильтр()
r = ActiveCell.Row
If Not ActiveSheet.AutoFilter Is Nothing Then
ActiveSheet.Cells.AutoFilter
Else
ActiveSheet.Range(Cells(r, 1), Cells(r, 100)).AutoFilter
End If
End Sub

В общем есть такой вопрос как из под Excel найти, запиcать в массив для последующей обработки заголовки всех окон имеющихся в диспечере задач. Я имею в виду те заголовки, что используются в Findwindow для получения hwnd. Сорри если просмотрел решение, заранее спасибо.

Ребят, может быть, такой вопрос уже был, но я не нашёл решения...

Задача следующая:

Есть табличка в следующем виде:

---------------------
Номер процесса
---------------------
Номер шага процесса
---------------------
Учатник процесса
---------------------

Необходимо написать макрос, который может автоматически переделывать табличку в следующий формат:
|Номер процесса|Номер шага процесса|Учатник процесса|
| | | |

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

Заранее огромное спасибо!

korol26
а если транспонировать, оно не?

korol26,
Стандартная функция "Копировать", "Специальная вставка" с галкой транспонировать. Если конечно акцент на этом, а не на "написать макрос"
Макрос вот. Он автоматом пишется:

Код: Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 2011-04-22 (***)
'

'
Range("B4:D10").Select
Selection.Copy
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

asbo
Ну таки файлы надо, смотреть надо, что и как куда.

Народ помогите плиз решить задачу в Excel с помощью VBA.
Условие задачи: При изменение ячеек, где вводятся цифры, должна строится шахматная доска ограниченная размером. Размер шахм. доски состоит из строк и столбцов.

Пример как должно выглядеть, на картинке ниже:

http://img10.imageshack.us/i/86495243.jpg

Заранее спасибо)))

black_dron, дык, помочь-то несложно. А что не получается?

black_dron

Цитата:

ри изменение ячеек, где вводятся цифры, должна строится шахматная доска ограниченная размером. Размер шахм. доски состоит из строк и столбцов.

[more]
размер в третьей строке первая вторая ячейки

Код: [no]
Private Sub Worksheet_Change(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
On Error GoTo E
For c = 1 To Cells(3, 1).Value
For r = 1 To Cells(3, 2).Value
If (c + r) Mod 2 = 0 Then
With Range(Cells(r * 2 - 1, c * 2 - 1), Cells(r * 2, c * 2)).Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
End If
Next
Next
Exit Sub
E:
MsgBox ("Введено неправильное число")
End Sub
[/no]

smirnvlad спасибо большое, все работает)))

Ребят подскажите пожалуйста, столкнулся с такой проблемой, есть экселевский документ с кодом VBA (написанный еще в 98 году). При открывании документа должно появлятся досовское окно (программа) с менюшкой вверху и исходными данными, которые хранятся в этом экселевском файле.
При попытке открыть на 7 винде выдает ошибку доступа или недоступности сервера и открывать отказывается.
На Хрюше выдает ошибку, что файл очень сильно поврежден, восстанавливает, пишет очень сильно поврежден и восстановить мало что удалось, в итоге показывает только исходные данные (тыкаю льт+ф11, чтобы глянуть код там везде все пусто). Т.е. не может восстановить сам код.
На Хрюше и через ОпенОфис открывает тоже только исходные данные (но не матерится и не предлагает ничего восстанавливать).

Прикол в чем, пробовал на 7 разных компах открыть, результат 0, попробовал еще на одном, открылось все с пол пинка (открыли в 03 офисе), прекрасно работает... Что у мя не так? х_х
стоит Хрюша, стоит офис (пробовал как 07, так и 03), подумываю на библиотеки VB, может из за них такое быть? Или мб у кого еще идеи есть, если надо могу сам файл скинуть.