Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 230 След.
Отсортировать текст из ячейки по столбцам, Отсортировать текст из ячейки по столбцам
 
Vladimir Kazimirchuk, для коллекции
Код
Sub mrshkei()
Dim arr, arr2, arr3, arr4, lr As Long
Dim i As Long, n As Long, x1 As Long, x2 As Long, x3 As Long, x4 As Long, x5 As Long
Range("C:H").Clear
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Array("Название", "ИНН", "Телефон", "Email", "Адрес", "Цена в заявке")
arr2 = Range("A1:A" & lr)
ReDim arr4(1 To lr * 20, 1 To 6): k = 1
For i = LBound(arr2) To UBound(arr2)
    arr3 = Split(arr2(i, 1), Chr(10))
    For n = LBound(arr3) To UBound(arr3)
        If Len(arr3(n)) > 10 Then
            x1 = Len(arr(0))
            x2 = InStr(arr3(n), arr(1))
            x3 = InStr(arr3(n), arr(2))
            x4 = InStr(arr3(n), arr(3))
            x5 = InStr(arr3(n), arr(4))
            x6 = InStr(arr3(n), arr(5))
            x7 = InStr(arr3(n), " руб.")
            
            arr4(k, 1) = Mid(arr3(n), x1 + 2, x2 - x1 - 3) ' название
            arr4(k, 2) = CStr(Mid(arr3(n), x2 + 5, 10)) ' ИНН
            arr4(k, 3) = CStr(Mid(arr3(n), x3 + Len(arr(2)) + 2, x4 - x3 - 10)) ' Телефон
            arr4(k, 4) = Mid(arr3(n), x4 + Len(arr(3)) + 2, x5 - x4 - 8) ' email
            arr4(k, 5) = Mid(arr3(n), x5 + Len(arr(4)) + 2, x6 - x5 - 8) ' Адрес
            arr4(k, 6) = Mid(arr3(n), x6 + Len(arr(5)) + 2, x7 - (x6 + Len(arr(5)) + 2)) ' сумма
            k = k + 1
        End If
    Next n
Next i
Range("C1").Resize(1, 6) = arr
Range("C2").Resize(UBound(arr4), 6) = arr4
End Sub
Изменено: Mershik - 6 мар 2021 14:37:03 (была ошибка в телеофнах)
Не бойтесь совершенства. Вам его не достичь.
Добавление нового товара в список автоматически.
 
Marat Ta, интересно "нет времени" - вы уже больше часа в теме отписываетесь... ну да ладно.
Не бойтесь совершенства. Вам его не достичь.
Добавление нового товара в список автоматически.
 
Vadim Mikayilov, короче вы пока определтесь вот вам скорректированный от Евгений Смирнов, доработаете
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Shet As Worksheet
Set Shet = ThisWorkbook.Worksheets(1)
If Target.Column = 2 And Application.WorksheetFunction.CountIf(Shet.Columns(1), Target) = 0 Then
    Target.Resize(, 3).Copy Shet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Else
    With Shet
        Set cell = .Columns(1).Find(Target)
        .Cells(cell.Row, 2) = .Cells(cell.Row, 2) + Target.Offset(0, 1)
        .Cells(cell.Row, 3) = .Cells(cell.Row, 3) + Target.Offset(0, 2)
        
    End With
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
Добавление нового товара в список автоматически.
 
Marat Ta, а вы что не напишите макрос?
Не бойтесь совершенства. Вам его не достичь.
Добавление нового товара в список автоматически.
 
Vadim Mikayilov, Вам нужно что бы товар с номер присваивался сам, а вы вводите количество и стоимость?  думаю вам стоит опиисать словами по порядку как в ы делаете вручную это
Изменено: Mershik - 6 мар 2021 09:18:04
Не бойтесь совершенства. Вам его не достичь.
Макрос скопировать значение вместо формулы и перенести в другую ячейку
 
Михаил Зубков, а вы его предоставили помогающим?  
Не бойтесь совершенства. Вам его не достичь.
[ Закрыто] Выборка
 
Петр, вы прям расписали все) прям все понятно(Нет)

http://perfect-excel.ru/publ/excel/polzovatelskij_interfejs/vypadajushhij_spisok_­s_kontekstnym_poisk...
Не бойтесь совершенства. Вам его не достичь.
Агрегация данных через Scripting.Dictionary, агрегация данных данных
 
Nordheim, а зачем они Вам) так же понятно нужно использовать
Цитата
Mergens написал:
Scripting.Dictionary
:D  
Не бойтесь совершенства. Вам его не достичь.
Создать новую книгу с одним листом и присвоить названия из ячеек
 
RenatKZ,
Код
Sub Макрос1()
NM = Range("A1")
WN = Range("A2")
If Dir(ThisWorkbook.Path & "\" & Range("A1") & ".xlsx", vbSystem) <> "" Then
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & NM & ".xlsx"
    Windows("\" & Range("A1") & ".xlsx").Activate
Else
    Workbooks.Add
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs _
    Filename:=ThisWorkbook.Path & "\" & NM & ".xlsx"
    Worksheets(1).Name = WN
    Application.DisplayAlerts = True
End If
End Sub


Изменено: Mershik - 5 мар 2021 11:27:47
Не бойтесь совершенства. Вам его не достичь.
Открыть файл выбранный и переместить его в другую папку!, Как средствами VBA открыть файл excel выбранный и переместить его в другую папку!
 
Цитата
Weltkind написал:
как средствами VBA открыть файл excel выбранный
https://vremya-ne-zhdet.ru/vba-excel/otkryt-knigu-sozdat-novuyu/
Цитата
Weltkind написал:
переместить его в другую папку
https://vremya-ne-zhdet.ru/vba-excel/kopirovaniye-i-peremeshcheniye-faylov/
Не бойтесь совершенства. Вам его не достичь.
При изменение данных в одной ячейки, происходит сброс данных в других ячейках
 
Николай Ершов, не за что возможно так удобнее
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E11")) Is Nothing Then
Dim cell As Range, i As Long
For i = 10 To 92 Step 7
    For n = 12 To 26 Step 5
        If cell Is Nothing Then
            Set cell = Range(Cells(n, i), Cells(n + 3, i + 2))
        Else
            Set cell = Union(cell, Range(Cells(n, i), Cells(n + 3, i + 2)))
        End If
    Next n
Next i
If Not cell Is Nothing Then cell.ClearContents
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
При изменение данных в одной ячейки, происходит сброс данных в других ячейках
 
Николай Ершов, в модуль листа - возможно кося в диапазоне очистки ну подправите
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E11")) Is Nothing Then
    Union(Range( _
        "BG22:BI25,BN22:BP25,BU22:BW25,CB22:CD25,CI22:CK25,J12:L15,Q12:S15,X12:Z15,AE12:AG15,AL12:AN15,AS12:AU15,AZ12:BB15,BG12:BI15,BN12:BP15,BU12:BW15,CB12:CD15,CI12:CK15,CI17:CK20,CB17:CD20,BU17:BW20,BN17:BP20,BG17:BI20,AZ17:BB20,AS17:AU20,AL17:AN20,AE17:AG20" _
        ), Range("X22:Z25,AE22:AG25,AL22:AN25,AS22:AU25,AZ22:BB25,J17:L20,J22:L25,Q17:S20,Q22:S25,X17:Z21")).ClearContents
End If
End Sub
Изменено: Mershik - 4 мар 2021 20:37:57
Не бойтесь совершенства. Вам его не достичь.
Сортировка диапазона по несколько строк по двум столбцам
 
nbaengineer, а в чем проблема?
выделяете диапазон A2:G38 - данные - сортировка - добавляем уровни Сортировать по X и сортировать по Y по убыванию - ок
Изменено: Mershik - 4 мар 2021 12:36:02
Не бойтесь совершенства. Вам его не достичь.
Заполнить столбец по условию совпадений из других столбцов
 
mugivara, да там не только можно им например так и думаю еще много вариантов в т.ч. и макросы
Код
=ЕСЛИОШИБКА(ИНДЕКС([значения заполнения];АГРЕГАТ(15;6;СТРОКА(Таблица1[[#Все];[значения заполнения]])/([Значения условия]=[@[Значения условия]])/([значения заполнения]<>"");1);1);"")
Не бойтесь совершенства. Вам его не достичь.
Заполнить столбец по условию совпадений из других столбцов
 
Цитата
mugivara написал:
Результат нужен рядом.
Код
=ЕСЛИОШИБКА(ПРОСМОТР(2;1/(([Значения условия]=[@[Значения условия]])*([значения заполнения]<>""));[значения заполнения]);"")
Изменено: Mershik - 4 мар 2021 12:20:37
Не бойтесь совершенства. Вам его не достичь.
Заполнить столбец по условию совпадений из других столбцов
 
mugivara, это не оно ?
https://www.planetaexcel.ru/techniques/2/96/ , но нет у Вас там не первые строки, всегда отсортировано? результат нужен рядом или в тех же ячейках?
Изменено: Mershik - 4 мар 2021 12:16:33
Не бойтесь совершенства. Вам его не достичь.
Заполнить столбец по условию совпадений из других столбцов
 
Цитата
mugivara написал:
есть таблица
нет таблицы
Цитата
mugivara написал:
есть значение
нет значения

наугад ВПР
Не бойтесь совершенства. Вам его не достичь.
Вытащить наименование населенного пункта (regexp)
 
Kuzmich, да все сохранено) просто это нужна практика) спасибо еще раз)
Не бойтесь совершенства. Вам его не достичь.
Вытащить наименование населенного пункта (regexp)
 
Vasil12, у меня так получилось

д[.?\s?]+[а-яА-ЯёЁ]+(\s*[а-яА-ЯёЁ]+(\s+|\b)|\s*)

Kuzmich, как бы начать разбираться в этом, я как в темном лесу)
Изменено: Mershik - 4 мар 2021 11:57:19
Не бойтесь совершенства. Вам его не достичь.
В каждой строке 15 значений, две строки нужно объединить между собой и получить 15 строк
 
DJMC, ничего не понял) покажите что не получилось и что должно - вы показали 1 строку 1 сделал по примеру
Изменено: Mershik - 4 мар 2021 10:01:18
Не бойтесь совершенства. Вам его не достичь.
В каждой строке 15 значений, две строки нужно объединить между собой и получить 15 строк
 
DJMC,
Код
=ЕСЛИ(ПСТР($A2;E$1;1)<>ПСТР($B2;E$1;1);ПСТР($A2;E$1;1)&ПСТР($B2;E$1;1);ПСТР($A2;E$1;1))
вы же обещали не писать подобные темы :D  (шутка)

что то у Вас в голове страшное)
Цитата
соединить строчки с данными разбив
и
Цитата
есть два столбца
Изменено: Mershik - 4 мар 2021 09:49:36
Не бойтесь совершенства. Вам его не достичь.
Выполнение плана в процентах на текущую дату
 
berkovich, формат ячейки процентный
Код
=(15.01.2021-01.01.2021)/(01.02.2021-01.01.2021)
Изменено: Mershik - 4 мар 2021 09:32:36
Не бойтесь совершенства. Вам его не достичь.
Вставить значение между постоянными
 
papay, здесь  в правилах есть пункт о файле-примере с исходными данными, и показанным желаемым результатом (если конечно хотите оперативно получить помощь) есть формулы  округления  
Изменено: Mershik - 4 мар 2021 08:52:42
Не бойтесь совершенства. Вам его не достичь.
Заполнение пустых столбцов по-порядку данных
 
bimbombig,
1. выделяете диапазон A5:J18 и запускаете макрос
Код
Sub mrshkei2()
Dim rng As Range
Set rng = Selection
rng.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub
2. или он же но вручную выделяете снова A5:J18 и нажимаете F5-выделить-пустые ячейки-ок-удалить-ячейки со сдвигом влево
3. или формулой см. файл
Код
=ЕСЛИОШИБКА(ИНДЕКС($A5:$J5;АГРЕГАТ(15;6;СТОЛБЕЦ($A$5:$J$5)/($A5:$J5<>"");СТОЛБЕЦ(A$1)));"")
Изменено: Mershik - 3 мар 2021 18:43:24
Не бойтесь совершенства. Вам его не достичь.
Заполнение пустых столбцов по-порядку данных
 
Цитата
bimbombig написал:
есть что еще добавить по существу?  
есть конечно - смотрите выше мое предложение
Изменено: Mershik - 3 мар 2021 17:21:21
Не бойтесь совершенства. Вам его не достичь.
Заполнение пустых столбцов по-порядку данных
 
bimbombig, а Marat Ta, ушел, но обещал вернуться
Не бойтесь совершенства. Вам его не достичь.
Сравнить два столбика с АРТИКУЛАМИ и к совпадающим артикулам подставить свою ЦЕНУ
 
Kar Vor, ВПР  или индекс+поискпоз или ПРОСМОТР  Вам в помощь
Не бойтесь совершенства. Вам его не достичь.
Сумматор двоичных чисел
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Можете в приложенном примере показать на паре строк(вбив руками): вот это исходные данные, а вот это надо получить? Там, думаю, всем будет понятнее.
поддерживаю)  
Не бойтесь совершенства. Вам его не достичь.
Заполнение пустых столбцов по-порядку данных
 
bimbombig, еще советую показать отдельно рядом желаемый результат.
Не бойтесь совершенства. Вам его не достичь.
Построить поверхность функции z(x, y)
 
Иванов Иван, для того что бы вы получили совет или готовое решение Вам необходимо предложить новое название темы (предложить тут в сообщении), а модераторы изменят (вы не сможете) в котором будет понятно что делаете (например Произвести расчет площади круга) и пример приложить с исходными данными и желаемым результатом.
сейчас тема не соответствует правилам и помощь скроют или тему удалят.
Изменено: Mershik - 3 мар 2021 14:24:21
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 230 След.
Наверх