» Excel VBA (часть 2)

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

kartav
Посмотри здесь

Добавлено:
zas
А что, "Trim" не устраивает (в рус. версии - "СЖПРОБЕЛЫ").

Цитата:

zas
А что, "Trim" не устраивает (в рус. версии - "СЖПРОБЕЛЫ").

не непомагает есть пробел или пробелы перед цифрой и после цифры и надо их убрать.

zas
Если, например, на рабочем листе Excel в ячейке "A1" находится " 5" (с пробелоами в начале или в конце), то вводим в "B1" формулу "=СЖПРОБЕЛЫ(A1)" и получим "5" без пробелов.
В VBA - Range("B1") = Trim(Range("A1")) уберет начальные и конечные пробелы, а Range("B1") = Application.Trim(Range("A1")) уберет еще и все "лишние" пробелы между словами, оставив по одному.

Уважаемые подскажите пожалуйста


Цитата:

Нашел в книге "Трюки и эффекты excel" пример простого калькулятора:

Sub simpleCalculator()
On Error GoTo errors

Dim strExpr As String
strExpr = InputBox("Под рукой нет калькулятора? Тогда вводите выражение в виде: 2+2*15/3*3-4+(5-2)/2 и нажмите Enter или OK", "Калькулятор")
MsgBox strExpr & "=" & Application.Evaluate(strExpr)


errors:
End Sub

Подскажите пожалуйста как можно сделать так чтобы ответ выводился рядом сразу же в процессе введения выражения. Т.е. чтобы рядом с знаком = сразу же при введении 2+2 выводилось 4, и если пользователь продолжить вводит выражения (например 2+2*7-1 и т.д.), то ответ должен считаться автоматически без нажатия на ОК или Enter. Попытался создать пользовательскую форму в виде: ВЫРАЖЕНИЕ=АВТОМАТИЧЕСКИЙ ОТВЕТ но так как знаний пока не хватает обращаюсь к профи.
Буду признателен за любую помощь.

Сделал форму где для ввода выражения (формулы) испольщуется MsgBox а для вывода Label.

Вписал следующий код:

Private Sub TextBox1_Change()

Dim strExpr As String
strExpr = TextBox1.Value
Label1.Caption = Application.Evaluate(strExpr)

End Sub

Конечно же вылезает ошибка.

ebrr

Цитата:

вылезает ошибка

либо перед вычислением самостоятельно проверяй строку на соответствие (чтобы в ней содержалось законченное выражение), либо там же ставь обработчик ошибок (к примеру, On Error Resume Next).

AndVGri

спасибо

SAS888


Цитата:

Код:Sub Main()

Dim i As Long, q As Long, LastR As Long
LastR = Cells(Columns("A").Rows.Count, "A").End(xlUp).Row ' Это номер последней строки в столбце "A"
i = 1
q = 2
Do While i < LastR
Do While q < LastR
Loop10: If Cells(i, "A") = Cells(q, "A") Then
Cells(i, "C") = Cells(i, "C") + Cells(q, "C")
Rows(q).Delete
LastR = LastR - 1
GoTo Loop10
End If
q = q + 1
Loop
i = i + 1
q = i + 1
Loop

End Sub

Спасибо огромное - все работает

Пытаюсь записать в макрос формулу из листа она очень длинная и мне выходит сообщение о том что запись не возможна?!?!?!

Добавлено:
записал в ручную, но пишет ИМЯ? и только после того как я захожу в ячейку и и ставлю курсор в поле её строки и жму enter все начинает работать

Здрасте снова всем. Возникла проблемка.
Итак, нужно прочитать файл bmp по символьно (ну как-будто блокнотом), делаю так

Цитата:

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(ActiveWorkbook.Path + "\" + "00000008_12.bmp", ForReading, False)
Set fail = fs.CreateTextFile(ActiveWorkbook.Path + "\" + "12.bmp", True)
Do While Not f.AtEndOfStream
fail.Write (f.Read(dl))
Loop

ну вот я дохожу до конца файла...все нормально, но потом позже требуется опять читать из файла 00000008_12.bmp и тут проблема:
пишет "что уже конец файла", если такое свойство, с помщью которого можно переместиться опять в начало файла.
п.с. щас я делаю close файла, а потом опять его открываю, но это как-то по тупому, с учетом того, что это в программе у меня встречается несколько раз...

kalinakrasnay
А чем классика с бинарным байтовым доступом плоха?

Код:
Dim fNum As Integer, bReader As Byte, bArray() As Byte
fNum = Freefile()
Open "d:\path\qqq.bmp" For Binary As #fNum Len=1
'Считать байт
Get #fNum, position, bReader
'Считать массив байтов
Redim bArray(1 To 5)
Get #fNum, position, bArray

AndVGri
Спасибо...но немного не то (видно я непонятно выразилась)

Цитата:

А чем классика с бинарным байтовым доступом плоха?

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

Цитата:

А это больше смахивает на копирование (полное) из одного файла в другой.

ну да, я делаю в том числе и копирование файлов (такое задание), ну а потом я так сказать скопированный файл "порчу"...

Подскажите, пожалуйста,
почему-то возникает ошибка (subscript out of range) в строке Set ws = Sheets(a(i))
хотя скрипт свою задачу выполняет.
и каковы правила записи
а то ошибка повторяется и в других примерах
спасибо.

Dim i As Integer, a
Dim ws As Worksheet
Application.ScreenUpdating = False

a = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
For i = 0 To UBound(a)
Set ws = Sheets(a(i))
With ws
.Unprotect (123)
Application.CutCopyMode = False

End With
Next
Application.ScreenUpdating = True

ol7ca
Надо добавить
"Option Base 1"
и изменить
"For i = 1 To UBound(a)"

или можно по другому, заменить
"For i = 0 To UBound(a)-1"

Мне больше нравится первый вариант.

ol7ca
Ваш код почти правильный. Замечания visual73 здесь ни при чем (какая разница, с какого числа начинается счет элементов массива).
Дело в другом:
Set ws = Sheets(a(i)), где a(i) = "1", VBA понимает как лист с именем "1", т. е. Sheets("1").
Если у Вас массив - это имена листов, то ошибки не будет. А если Вы имеете ввиду номера листов, то для обращения к листу нужно преобразовать тип данных элемента массива.
Т. е. так: Sheets(CInt(a(i))). Ошибки тоже не будет.
Второй вариант:
Просто убрать кавычки при задании элементов массива. Т. е. так:
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
Тогда компилятор "увидит" не текст, а именно номер.

Можно как-нибудь сделать чтобы второе условие, после слова OR, не проверялось? для случая A>5?
"If A > 5 Or B>20 Then"
SAS888
это потенциальная ошибка

visual73
По-моему, в случае с оператором Or, если первое условие выполняется (а этого уже достаточно, чтобы выражение под If стало =True), все последующее и так не проверяются.
Могу ошибаться, чтобы это проверить - проведите какой-нибудь тест по времени выполнения кода для разных случаев.

SAS888
Вот, вот. В том то и дело что уже проверил Результат совсем мне не нравится.

Sub test()
i = 0
j = 5
If i = 0 Or ggg(j) = 3 Then
f = 1
End If
End Sub

Function ggg(j)
ggg = j
End Function

По любому идет в ggg.
На фига она ей нужна, спрашивается? Вот блин!
Жаль. Буду думать другие варианты.

visual73
Ну, тогда проверять последовательно - сначала "быстрое" условие, затем другое. Например:
Sub test()
i = 0
j = 5
If i = 0 Then
f = 1
Else
If ggg(j) = 3 Then f = 1
End If
End Sub

Function ggg(j)
ggg = j
End Function

В наличии есть несколько папок:
D:\0401\Входящие\ - множество файлов *.xls
................................
D:\0423\Входящие\ - множество файлов *.xls
вот эти *.xls самые файлы мне и нужно во всех папках "Входящие" переименовать в дату изменения файла + добавить нумерацию "()"и к этому имени добавить название каталога который находиться на один уровень выше, пример 06.03.2008.(1).0423.xls , а если в наличии окажеться ещё один файл с такимже именем то 06.03.2008.(2).0423.xls и.т.д
Но остановился я на слудующем - в хелпах и нете нашёл море информации из которой "понял" (не полностью) как работает поиск
и вот на этом примере не могу понять каким образом дописать код,
1 - я должен, вместо вывода на экран сделай вызов фунции которая в качестве аргумента будет принимать имена файлов
2 - MyDateTime = FileDateTime("D:\TEMP\FileSearch\*.xls) эта функция из файла получает дату формирует имя и переименовывает файл
Подскажите в какую степь мне двигаться или где лучше поискать!

Код: Sub rename()
Dim MyDateTime As Date
Set fs = Application.FileSearch
With fs
.LookIn = "D:\TEMP\FileSearch\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
MsgBox "Число найденных файлов = " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "Нет файлов"
End If
End With

Sunnych
Предлагаемый вариант найдет нужные файлы и выполнит над каждым из них нужные Вам действия.

Код: Sub rename()

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "D:\TEMP\FileSearch\"
.FileName = "*.xls"
.Execute
If .FoundFiles.Count = 0 Then
MsgBox "Файлы не найдены"
Exit Sub
End If
End With

For i = 1 To fs.FoundFiles.Count
Call ProcessFiles(fs.FoundFiles(i))
Next i

End Sub

Sub ProcessFiles(FileName As String)

'Здесь расположите Ваш код
'который будет исполняться для каждого
'найденного файла
'входной параметр - имя файла (например: Workbooks.Open FileName:=FileName)

End Sub

Опять за консультацией, вот есть строчка проги...
If kol_osh / dlina > 0.000001 Then

короче kol_osh и dlina изначально описаны как integer (не знаю правильно ли это)
kol_osh / dlina - получается число порядка 1,3333E-3

все отлично,
но мне нужно чтобы вместо 0.000001, брались данные из label, который находится на форме, и тогда возникает проблема: несовместимые типы, в какой только тип я не пробывала преобразовывать данные из лейбл и все одно и тоже, опять ошибка...подскажите!

Добавлено
ой, все получилось, вот это я ступила....
в label надо вводить число ч/з ",", а не ч/з точку...
бейсик меня попутал...

Ребята не поймите меня превратно:
в чем может быть дело: Макрос на ура отрабатывает примерную таблицу с 500 строками,
а когда тот же макрос начинает обробатывать 15000 строк - Excel вывешивается...


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

SAS888


Цитата:

Set ws = Sheets(a(i))
Если у Вас массив - это имена листов, то ошибки не будет.

это имена листов но ошибка есть

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

Dim ws As Worksheet, wb As Workbook
Application.ScreenUpdating = False
Set wb = Application.Workbooks("MAP2.xls")
For Each ws In wb.Worksheets
If ws.Type = xlWorksheet Then
For i = 1 To ws.Cells(65536, 28).End(xlUp).Row
If IsNumeric(ws.Cells(i, 28)) Then 'And ws.Cells(i, 28) <> "" Then
ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]A'!C6:C8,3,FALSE)"
End If
Next
End If
Next

спасибо

ol7ca
1. Протестил ваш код обращения к листам книги из массива. Код рабочий. Проверьте наличие всех имен листов, которые содержатся в массиве.
2. По поводу
Цитата:

что нужно сделать, чтобы скрипт проходя по текущему листу, в эту формулу вставлял имя текущего листа?

Если имеется ввиду строка
Код: ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]A'!C6:C8,3,FALSE)"

SAS888, Спасибо - я в VBA не сильно силен но все же...

В моем случае помогло вставка в Цикл DoEvents

SAS888

спасибо


Цитата:

И еще. Зачем у Вас проводится проверка
Цитата:If ws.Type = xlWorksheet Then

не могу ответить на этот вопрос
такой пример кода мне кто то дал этом форуме
что-то не так?

Добавлено:

Цитата:

Код:ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]" & ws.Name & "'!C6:C8,3,FALSE)"

сообщает об ошибке application-defined or object-defined error
хотя этот работает

Цитата:

Код:ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]A'!C6:C8,3,FALSE)"

все дело в том, что " & ws.Name & "кодом воспринимается как название листа

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

как это сделать?
спасибо

ol7ca
1. Проверка
Цитата:

If ws.Type = xlWorksheet Then

- это лишнее, т.к. Вы описываете
Цитата:

Dim ws As Worksheet

2. По поводу
Цитата:

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

Пусть в столбце "A", начиная с ячейки "A1", находятся какие-нибудь значения.
Следующий макрос "просматривает" их, и если это значение является именем ячейки, то в столбец "B" этой же строки помещается значение ячейки с этим именем.

Код: Sub NameCell()

For i = 1 To Cells(Cells.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
Cells(i, "B") = Range(Cells(i, "A"))
Next

End Sub

SAS888

Цитата:

И еще. Зачем у Вас проводится проверка
Цитата:If ws.Type = xlWorksheet Then

ol7ca
Цитата:

Цитата:
не могу ответить на этот вопрос
такой пример кода мне кто то дал этом форуме
что-то не так?

Надо, по крайней мере в Excel 2000. Я давал.
SAS888

Цитата:

ol7ca
1. Проверка
Цитата:If ws.Type = xlWorksheet Then

- это лишнее, т.к. Вы описываете
Цитата:Dim ws As Worksheet

По логике - согласен, лишнее. Но Excel 2000 (не знаю, как остальные версии) всё равно возвращает листы всех типов. Даже если вы работаете в версии, которая корректно возвращает типы листов, всё равно стоит проверять, чтобы была совместимость.

Добавлено:
DocBeen

Цитата:

В моем случае помогло вставка в Цикл DoEvents

Вы поосторожнее с этим. Иногда бывают проблемы с DoEvents.

Добавлено:
kalinakrasnay

Цитата:

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

Код: Private Sub CommandButton1_Click()
Dim f As Single

f = Val(Label1.Caption)
Debug.Print f
End Sub

SAS888
nick7inc
спасибо за помощь!

SAS888
поиск имени работает отлично


пожалуйста, подскажите еще как решить это:

Код:ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]" & ws.Name & "'!C6:C8,3,FALSE)"

сообщает об ошибке application-defined or object-defined error
хотя этот работает
Цитата:
Код:ws.Cells(i, 27) = "=VLOOKUP(RC[-3],'[1.xls]A'!C6:C8,3,FALSE)"

все дело в том, что " & ws.Name & "кодом воспринимается как название листа

я уже все перепробывал(
мне нужно чтобы функция брала имя текущего листа
т.к. всего 50 листов куда это надо вставить.

спасибо