Sub Auto_Open() Dim strName$: strName = Replace(ThisWorkbook.Name, "_New", "") If InStr(ThisWorkbook.FullName, Application.UserLibraryPath) < 1 Then On Error Resume Next Application.Workbooks(strName).Close 0 On Error GoTo 0 With CreateObject("Scripting.FileSystemObject") .CopyFile ThisWorkbook.FullName, Application.UserLibraryPath & strName, 1 Do DoEvents Loop Until .fileexists(Application.UserLibraryPath & strName) End With End If Application.AddIns(Left(strName, InStrRev(strName, ".") - 1)).Installed = True If Workbooks.Count = 0 Then Workbooks.Add End Sub
Sub Auto_Open() Dim strName$: strName = Replace(ThisWorkbook.Name, "_New", "") If InStr(ThisWorkbook.FullName, Application.UserLibraryPath) < 1 Then On Error Resume Next Application.Workbooks(strName).Close 0 On Error GoTo 0 With CreateObject("Scripting.FileSystemObject") .CopyFile ThisWorkbook.FullName, Application.UserLibraryPath & strName, 1 Do DoEvents Loop Until .fileexists(Application.UserLibraryPath & strName) End With End If Application.AddIns(Left(strName, InStrRev(strName, ".") - 1)).Installed = True If Workbooks.Count = 0 Then Workbooks.Add End Sub
Sub test() Dim rng As Range, col&, criteria$, delim$, str$ Set rng = [Лист1!A2:A9]: col = 1: criteria = 1: delim = ", " str = СцепитьЕсли(rng.Offset(, col), criteria$, rng, delim) End Sub
[/vba]
[vba]
Код
Sub test() Dim rng As Range, col&, criteria$, delim$, str$ Set rng = [Лист1!A2:A9]: col = 1: criteria = 1: delim = ", " str = СцепитьЕсли(rng.Offset(, col), criteria$, rng, delim) End Sub
Function СцепитьЕсли(ByRef Диапазон As Range, _ ByVal Критерий As String, _ ByRef Диапазон_сцепления As Range, _ Optional Разделитель As String = " ") As String '--------------------------------------------------------------------------------------- ' Procedure : СцепитьЕсли ' Author : The_Prist & Alex_ST ' Topic_HEADER : "Помогите создать СЦЕПИТЬЕСЛИ() - аналог СУММЕСЛИ()" ' Topic_URL : http://www.planetaexcel.ru/forum.php?thread_id=14935 ' Post_Author : The_Prist ' Post_URL : http://www.planetaexcel.ru/docs/forum_upload/post_113923.xls ' DateTime : 02.04.2010 22:24 ' Purpose : СЦЕПИТЬЕСЛИ() - аналог СУММЕСЛИ() ' Notes : По умолчанию разделитель слов - пробел, но можно задать любой другой символ/символы. ' Диапазон - диапазон с критериями(указывается один столбец) ' Критерий - критерий. Просматривается Диапазон. ' Диапазон_сцепления - из этого диапазона берется значение для сцепления, ' если значение в аргументе Диапазон совпадает с аргументом Критерий (указывается один столбец). '--------------------------------------------------------------------------------------- Dim rCell As Range, rFndrng As Range, sStr As String Set Диапазон = Intersect(Диапазон, ActiveSheet.UsedRange) Set Диапазон_сцепления = Intersect(Диапазон_сцепления, ActiveSheet.UsedRange) For Each rCell In Диапазон If rCell.Value Like Критерий Then If Trim(Диапазон_сцепления.Cells(rCell.Row - Диапазон.Row + 1, 1)) <> "" Then _ sStr = sStr & IIf(sStr <> "", Разделитель, "") & Диапазон_сцепления.Cells(rCell.Row - Диапазон.Row + 1, 1) End If Next rCell СцепитьЕсли = sStr End Function
Function СцепитьЕсли(ByRef Диапазон As Range, _ ByVal Критерий As String, _ ByRef Диапазон_сцепления As Range, _ Optional Разделитель As String = " ") As String '--------------------------------------------------------------------------------------- ' Procedure : СцепитьЕсли ' Author : The_Prist & Alex_ST ' Topic_HEADER : "Помогите создать СЦЕПИТЬЕСЛИ() - аналог СУММЕСЛИ()" ' Topic_URL : http://www.planetaexcel.ru/forum.php?thread_id=14935 ' Post_Author : The_Prist ' Post_URL : http://www.planetaexcel.ru/docs/forum_upload/post_113923.xls ' DateTime : 02.04.2010 22:24 ' Purpose : СЦЕПИТЬЕСЛИ() - аналог СУММЕСЛИ() ' Notes : По умолчанию разделитель слов - пробел, но можно задать любой другой символ/символы. ' Диапазон - диапазон с критериями(указывается один столбец) ' Критерий - критерий. Просматривается Диапазон. ' Диапазон_сцепления - из этого диапазона берется значение для сцепления, ' если значение в аргументе Диапазон совпадает с аргументом Критерий (указывается один столбец). '--------------------------------------------------------------------------------------- Dim rCell As Range, rFndrng As Range, sStr As String Set Диапазон = Intersect(Диапазон, ActiveSheet.UsedRange) Set Диапазон_сцепления = Intersect(Диапазон_сцепления, ActiveSheet.UsedRange) For Each rCell In Диапазон If rCell.Value Like Критерий Then If Trim(Диапазон_сцепления.Cells(rCell.Row - Диапазон.Row + 1, 1)) <> "" Then _ sStr = sStr & IIf(sStr <> "", Разделитель, "") & Диапазон_сцепления.Cells(rCell.Row - Диапазон.Row + 1, 1) End If Next rCell СцепитьЕсли = sStr End Function
ВладимирG, источник данных в Excel? тогда в первую ячейку столбца в excel впишите числовое значение и на столбец установите числовой формат или используйте запрос из моего предыдущего поста (дополнил)
Тип данных Чтобы исключить возникновение ошибок в ходе импорта, убедитесь, что все исходные столбцы содержат данные одинакового типа в каждой строке. Приложение Access считывает первые восемь исходных строк и определяет по ним тип данных полей таблицы. Настоятельно рекомендуется не использовать в первых восьми строках всех столбцов значения разных типов, поскольку в противном случае приложение Access может неправильно определить тип данных столбца. Рекомендуется также отформатировать все исходные столбцы в Excel и назначить им определенный формат данных перед началом операции импорта. Форматирование является необходимым, если столбец содержит значения с различными типами данных. Например, столбец "Номер рейса" может содержать числовые и текстовые значения, такие как 871, AA90 и 171. Чтобы исключить отсутствующие или неверные значения, выполните указанные ниже действия.
ВладимирG, источник данных в Excel? тогда в первую ячейку столбца в excel впишите числовое значение и на столбец установите числовой формат или используйте запрос из моего предыдущего поста (дополнил)
Тип данных Чтобы исключить возникновение ошибок в ходе импорта, убедитесь, что все исходные столбцы содержат данные одинакового типа в каждой строке. Приложение Access считывает первые восемь исходных строк и определяет по ним тип данных полей таблицы. Настоятельно рекомендуется не использовать в первых восьми строках всех столбцов значения разных типов, поскольку в противном случае приложение Access может неправильно определить тип данных столбца. Рекомендуется также отформатировать все исходные столбцы в Excel и назначить им определенный формат данных перед началом операции импорта. Форматирование является необходимым, если столбец содержит значения с различными типами данных. Например, столбец "Номер рейса" может содержать числовые и текстовые значения, такие как 871, AA90 и 171. Чтобы исключить отсутствующие или неверные значения, выполните указанные ниже действия.
ВладимирG, это запрос к таблице access? если да, проверьте тип данных поля F21 в конструкторе если это запрос к листу Excel, нужно убедиться в том, что в соответствующем столбце стоят числовые значения мб так попробовать [vba]
Код
SELECT [Заказы покупателей].F2, [Заказы покупателей].F3, [Заказы покупателей].F21, IIf(InStr([f3],"Код:")<>"",Mid([f3],InStr([f3],"Код:")+5,20),"") AS [В базе] FROM [Заказы покупателей] WHERE [F21]>0 and [F21] is not null
[/vba] или так [vba]
Код
SELECT [Заказы покупателей].F2, [Заказы покупателей].F3, [Заказы покупателей].F21, IIf(InStr([f3],"Код:")<>"",Mid([f3],InStr([f3],"Код:")+5,20),"") AS [В базе] FROM [Заказы покупателей] WHERE Iif(IsNumeric([F21]);Clng([F21]);0)>0
[/vba]
ВладимирG, это запрос к таблице access? если да, проверьте тип данных поля F21 в конструкторе если это запрос к листу Excel, нужно убедиться в том, что в соответствующем столбце стоят числовые значения мб так попробовать [vba]
Код
SELECT [Заказы покупателей].F2, [Заказы покупателей].F3, [Заказы покупателей].F21, IIf(InStr([f3],"Код:")<>"",Mid([f3],InStr([f3],"Код:")+5,20),"") AS [В базе] FROM [Заказы покупателей] WHERE [F21]>0 and [F21] is not null
[/vba] или так [vba]
Код
SELECT [Заказы покупателей].F2, [Заказы покупателей].F3, [Заказы покупателей].F21, IIf(InStr([f3],"Код:")<>"",Mid([f3],InStr([f3],"Код:")+5,20),"") AS [В базе] FROM [Заказы покупателей] WHERE Iif(IsNumeric([F21]);Clng([F21]);0)>0
Private Sub CommandButton4_Click() 'Код для сохранения данных заявки на лист Журнала заявок With Worksheets("транспортный журнал").ListObjects("Таблица1").QueryTable .Connection = "ODBC;DSN=Excel Files;;DriverId=1046;DBQ=" & ThisWorkbook.FullName .Refresh End With End Sub
[/vba]
lebensvoll, а как вам такой вариант? [vba]
Код
Private Sub CommandButton4_Click() 'Код для сохранения данных заявки на лист Журнала заявок With Worksheets("транспортный журнал").ListObjects("Таблица1").QueryTable .Connection = "ODBC;DSN=Excel Files;;DriverId=1046;DBQ=" & ThisWorkbook.FullName .Refresh End With End Sub
Здравствуйте Главная>редактирование>заменить В поле Найти пишем ^9*[^13^l] В поле Заменить пишем ^& жмем Больше>формат>шрифт, выбираем полужирный, ОК Тык по галке Подстановочные знаки Тык по кнопке Заменить все
Здравствуйте Главная>редактирование>заменить В поле Найти пишем ^9*[^13^l] В поле Заменить пишем ^& жмем Больше>формат>шрифт, выбираем полужирный, ОК Тык по галке Подстановочные знаки Тык по кнопке Заменить всеkrosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
