Универсальный поиск по диапазону (переписать)

‘ Универсальная функция возврата даты Function GetMes_New(r As Range) As String Dim arr(12) As String Dim adress1 As Integer arr(0) = «январь» arr(1) = «февраль» arr(2) = «март» arr(3) = «апрель» arr(4) = «май» arr(5) = «июнь» arr(6) = «июль» Продолжить чтение Универсальный поиск по диапазону (переписать)

Быстрый поиск с заменой

Sub kos20() Dim x columns(1).copy columns(2) For Each x In Range(«H1:H3″).Value ‘массив искомых слов в H1:H3 ‘массив текста в 1 столбце, массив результатов во 2 столбце Columns(2).Replace What:=»*» & x & «*», Replacement:=x, _ LookAt:=xlWhole, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Продолжить чтение Быстрый поиск с заменой

Получить текст между кавычками

Function GetNormalNeme(r As Range) As Variant s_left = InStr(1, r, Chr(34), vbTextCompare) s_right = InStr(s_left + 1, r, Chr(34), vbTextCompare) If s_left = 0 Then GetNormalNeme = r Else GetNormalNeme = Mid(r, s_left + 1, s_right — s_left — 1) Продолжить чтение Получить текст между кавычками

Получить число из текста

‘Последнее число Function delcr2000(r As Range) Dim arr() As String ReDim arr(200) For i = 1 To Len(r) arr(i) = Mid(r, i, 1) If IsNumeric(Mid(r, i, 1)) Then arr(i) = Mid(r, i, 1) If Mid(r, i, 1) = » » Продолжить чтение Получить число из текста

Сумма прописью от http://mtdmacro.ru (платежка)

‘ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ‘ (C) Александр, http://mtdmacro.ru, mtdmacro@mail.ru ‘ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Option Explicit Private N(1 To 14) As Byte Private A, строка As String Private A1_муж, A1_жен, A2, a3, a0 Function Пропись(Сумма, Optional Показывать_ноль_копеек As Boolean) Dim Миллиарды, Миллионы, Тысячи, Рубли, Копейки Продолжить чтение Сумма прописью от http://mtdmacro.ru (платежка)

Подгон высоты ячейки под длину текста (переделать)

‘Типа автоформат Sub SetRowHeight() Application.ScreenUpdating = False For Each ac In Selection sss = Round(Len(ac.Value) / ac.ColumnWidth, 0) If ac.ColumnWidth * 2 < Len(ac.Value) Then ac.RowHeight = sss Else: ac.RowHeight = ac.RowHeight End If Next Application.ScreenUpdating = True End Sub

Поиск компаний для 51 счета

‘Процедура получает данный из столбца N(наименования компаний берутся из 60,62 счетов) и Заполняет контрагентов Sub ПолучитьКонтрагентов() For i = 6 To shd.Cells.SpecialCells(xlLastCell).Row For ii = 1 To 12 If Not Range(«C» & i).Find(Range(«N» & ii)) Is Nothing Then ‘исходные данные Продолжить чтение Поиск компаний для 51 счета

приход по 51

‘Option Explicit »Возможные варианты: ДебетН, КредитН, ДебетО, КредитО, ДебетК, КредитК Sub main() ‘ Удаление существующего листа сводной таблицы Dim Sname As String Sname = «Приходы» Call delSheet(Sname) Dim arr0() As String Dim arr() As String Dim arr1() As String Dim Продолжить чтение приход по 51

Передача массива в процедуру

Sub test() Dim arr1() As String ReDim arr1(3) arr1(0) = «51» arr1(1) = «91.02» arr1(2) = «60.01» Call test2(arr1) End Sub Sub test2(ByRef arr() As String) For i = 1 To 100 For i0 = 0 To UBound(arr, 1) — Продолжить чтение Передача массива в процедуру