Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
Другие темы раздела
VBA Найти среднее значение элементов второго столбца матрицы http://www.cyberforum.ru/vba/thread713612.html
найти среднее значение элементов 2-го столбца, максимальное значенне этих элементов и количество значений меньших 78. Вот что у меня получилось, но оно не работает чего-то, помогите пожалуйста ...
Обращение к файлам rtf из VBA Word для копирования содержимого VBA
Кто знает каким образом можно копировать части rtf файла в ворд? Как пример кусочек кода: fname = "C:\НАКАЗ.rtf" Set doc2 = ActiveDocument ActiveDocument.Content.Text = "" ...
VBA Автосортировка по указаному номеру столбца
Всем доброго времени суток. У меня возникла такая проблема. Не знаю как осуществить следующее. Есть файл эксель, там много столбцов. И есть ячейка. Если мы укажем в ячейке, к примеру 1, сортируется...
VBA Вставка относительных ссылок в формулу посредством переменных Добрый день. я который раз возвращаюсь к одной загвоздке в своем макросе и никак не могу ее решить. помогите пожалуйста. есть вырезка из кода: k = ActiveCell.Offset(-9, -5).Address(0, 0,... http://www.cyberforum.ru/vba/thread713425.html
VBA Построение диаграммы. Создание нового тега и ошибка "type mismatch" http://www.cyberforum.ru/vba/thread713324.html
Здравствуйте! После запуска макроса выдает ошибку run-time error 13 type mismatch в этом месте кода: X1 = Range(Workbooks(MyName).Worksheets(MyDannie).Cells(iRowi + 7, iClmj + 3),...
Поиск на листах и систематизация данных VBA
На "Лист1" в 1 столбце находится список организаций в столбец 2 и 3 должны копироваться данные со 2 и 3 листа. На 2 и 3 Лист выгружаются данные из разных программ 1С и ИМУС нужно что бы макрос...
VBA Переключение языка ввода в зависимости от столбца
Добрый день! Есть таблица из двух колонок. Как прописать макрос, который бы делал следующее?: 1. если курсор находится в первой колонке - язык ввода становится русским 2. если курсор находится...
VBA Получить метки дисков Есть форма для выбора диска, на который нужно сохранить отчет Excel. Т.к. очень часто нужно сохранить отчет на флешку, возникла необходимость выводить в ComboBox не только букву диска, но и его метку... http://www.cyberforum.ru/vba/thread713166.html
VBA Проверка на число в InputBox вызывает ошибку http://www.cyberforum.ru/vba/thread713125.html
a = InputBox("a") Do While Not IsNumeric(a) MsgBox "Ошибка" a = InputBox("a") Loop b = InputBox("b") Do While Not IsNumeric(b) MsgBox "Ошибка" b = InputBox("b") Loop
VBA Реализовать оповещение, если в заданный промежуток времени от адресата нет письма Как можно реализовать оповещение, если в заданный промежуток времени от адресата нет письма. К примеру есть адресаты с ящиками ввида: mail1@example.com mail2@example.com ............ http://www.cyberforum.ru/vba/thread713123.html
Апострофф
Заблокирован
17.11.2011, 21:56 0

Авторские программы, библиотеки, надстройки и шаблоны

17.11.2011, 21:56. Просмотров 145061. Ответов 179
Метки (Все метки)

Ответ

Первый вариант
SpecCharCls
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Public Function SpecCharCls( _
        ByVal strSearchIn As String, _
        Optional ByVal blnTrim As Boolean = False, _
        Optional ByVal blnSpaseDelete As Boolean = False _
        ) As String             '=== функция: очистка строки от спец. символов
    ' strSearchIn       - исходная строка
    ' blnTrim           - флаг: удалить начальные и конечные пробелы из итоговой строки
    ' blnSpaseDelete    - флаг: удалить все пробелы
    Dim i As Integer
    Dim siMid As String * 1     ' выделенный символ
    'Dim strNew As String        ' "очищенная" строка
    'Dim siAsc As Integer        ' ANCI код символа
    'Dim siLen As Integer        ' длинна очищаемой строки
    
    SpecCharCls = strSearchIn    ' перадаём строку локальной переменной
    ' удаляем все пробелы из строки
    ' если удаляем все пробелы, лучше это сделать сразу - цикл будет короче
 
'    If blnSpaseDelete = True Then SpecCharCls = Replace(SpecCharCls, " ", "")
    If blnSpaseDelete Then SpecCharCls = Replace(SpecCharCls, " ", "") 'зачем лишние сравнения для булевой переменной
    'siLen = Len(SpecCharCls)     ' считаем длинну строки
    For i = 1 To Len(SpecCharCls)      ' перебераем все символы строки по циклу
        siMid = Mid(strSearchIn, i, 1)  ' получаем символ из строки
        'siAsc = Asc(siMid)              ' преобразовываем полученный символ в ANCII код
        If siMid < " " Then SpecCharCls = Replace(SpecCharCls, siMid, "")  ' удаляем спец.символ
    Next i
    ' удаляем пробелы в начале и в конце строки. Это лучше делать в конце цикла,
    ' т.к. в исходной строке могут быть пробелы "экранированные" спец. символами
 
'    If blnTrim = True Then SpecCharCls = Trim(SpecCharCls)
    If blnTrim Then SpecCharCls = Trim(SpecCharCls) 'зачем лишние сравнения с True?
    'SpecCharCls = SpecCharCls             ' возвращаем результат
End Function

То же самое, только в два раза быстрее
SpecCharCls3
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function SpecCharCls3( _
        ByVal strSearchIn As String, _
        Optional ByVal blnTrim As Boolean = False, _
        Optional ByVal blnSpaseDelete As Boolean = False _
        ) As String             '=== функция: очистка строки от спец. символов
    ' strSearchIn       - исходная строка
    ' blnTrim           - флаг: удалить начальные и конечные пробелы из итоговой строки
    ' blnSpaseDelete    - флаг: удалить все пробелы
    Dim b() As Byte, a() As Byte
    b = strSearchIn
    ReDim a(UBound(b))
    Dim i As Long, J As Long
    For i = 0 To UBound(b) Step 2
      If b(i) >= 32 - blnSpaseDelete Or b(i + 1) > 0 Then
        a(J) = b(i)
        a(J + 1) = b(i + 1)
        J = J + 2
      End If
    Next i
    ReDim Preserve a(J - 1)
    If blnTrim Then SpecCharCls3 = Trim$(a) Else SpecCharCls3 = a
End Function

И для любителей экстрима
SpecCharCls4
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
Private Type TSafeArray
    Dims As Integer
    Features As Integer
    ElementSize As Integer
    Locks As Integer
    Handle As Long
    DataPtr As Long
    Length As Long
    LBound As Long
End Type
 
Private Declare Sub SetCharArray Lib "msvbvm60" Alias "GetMem4" (ByRef SafeArrayPtr As Long, ByRef CharArray() As String * 1)
 
Dim sa As TSafeArray, a() As String * 1
 
Public Function SpecCharCls4(ByVal strSearchIn As String) '
SetCharArray VarPtr(sa), a
With sa
    .Dims = 1
    .Features = 128
    .ElementSize = 2
    .Locks = 0
    .Handle = 0
    .LBound = 0
    .DataPtr = StrPtr(strSearchIn)
    .Length = Len(strSearchIn)
End With
 
Dim I As Long
For I = 0 To UBound(a)
  If a(I) < " " Then a(I) = Chr$(0)
Next I
SpecCharCls4 = Trim$(Replace(strSearchIn, Chr$(0), ""))
SetCharArray 0&, a
End Function

Как пользоваться:
Visual Basic
1
2
3
4
Sub qqq()
Dim s$: s = "   " & vbTab & "  dfghjdf  " & vbTab & "   dsthf  " & vbLf & "  kln  jkn   " & vbCr & "      "
  MsgBox SpecCharCls3(s, True, True)
End Sub
Нужны проверки, явно присутствуют возможности для оптимизации.
Но даже на этой стадии данный код быстрее вышеизложенных.

Другие сообщения этой темы: Очистка строки от от спец. символов ("Tab", перевод каретки и пр.)

Вернуться к обсуждению:
Авторские программы, библиотеки, надстройки и шаблоны
10
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
17.11.2011, 21:56

Хранить шаблоны документов в базе и выводить данные в эти шаблоны
Доброго времени суток. Интересует вопрос: мне необходимо формировать вордовские документы по...

Библиотеки программы
Знаю, что подобные темы обсуждались, но ничего путного не нашел. Написал программу CLR, но...

Чем отличаются шаблоны HTML и шаблоны WordPress
В чём различие между шаблонами HTML и WordPress. Кроме того, что создаются они разными способами....

0
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.