Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 След.
Сравнить два листа, Лист1 пункты товара без данных, Лист2 пункты товара с данными для отдельных пунктов, Лист3 результат равный таблице на Лист1 с данными из Лист2
 
artemkau88, низкий поклон и большое спасибо, работает.
Сравнить два листа, Лист1 пункты товара без данных, Лист2 пункты товара с данными для отдельных пунктов, Лист3 результат равный таблице на Лист1 с данными из Лист2
 
Пример с данными через плюс.
Сравнить два листа, Лист1 пункты товара без данных, Лист2 пункты товара с данными для отдельных пунктов, Лист3 результат равный таблице на Лист1 с данными из Лист2
 
Цитата
написал:
А данные из первого столбца уникальные (т.е. не повторяются)?
artemkau88, да, не повторяются, всегда уникальные.

Большое вам спасибо, работает.

Один момент всё же упустил, данные бывают в формате, как одного числа, так и соединенные через пробел, знак плюс, пробел.
7
8 + 4
10 + 11 + 8 + 24
Можно ли доработать, чтоб результат суммы чисел попадал в столбец данных?
7
12
53
Изменено: Novichok55 - 12.07.2023 15:31:20
Сравнить два листа, Лист1 пункты товара без данных, Лист2 пункты товара с данными для отдельных пунктов, Лист3 результат равный таблице на Лист1 с данными из Лист2
 
Здравствуйте.
Окажите пожалуйста макропомощь. Пример прилагаю.

На Лист 1 в два столбца идут пункты товара, напротив каждого пустые данные по второму столбцу.

На Лист2 в два столбца идут пункты товара, напротив каждого либо пустые либо численные данные.

Вывести на Лист3 таблицу с первого листа (все строки, даже те которые останутся без данных), но уже с данными взятыми с Лист2.
Вставка из 1с чисел разделенных запятой
 
Ігор Гончаренко
огромное спасибо! После смены умножить на поделить, получаю то что нужно :) Плюс для крайне редкой вставки нормально выглядящих чисел (у меня или все нормальные вставляются за одну отдельно взятую вставку или все "ненормальные" из 1С), которые точно и до значения 900 не доходят изменил условие на
Код
If Val(ActiveCell) > 999
ведь всё что с 1С, будет как минимум равно 1000 и более.
Изменено: Novichok55 - 20.06.2018 23:36:58
Вставка из 1с чисел разделенных запятой
 
Здравтвуйте.
Помогите пожалуйста. При помощи ниже приведенного макроса, копирую из 1с "постолбцово" три колонки.
Текстовые нормально копируются через макрос, но когда доходит до числового столбца, имеющего внешний вид в 1с 155,000 оно вставляется как 155 000 или при использовании Selection.NumberFormat = "0"  как 155000

Код
Sub odins1()    
ActiveSheet.Paste    
Selection.NumberFormat = "0"    
ActiveCell.Offset(0, 1).Activate    
Sheets("Лист2").Select    
ActiveSheet.Paste    
Selection.NumberFormat = "0"    
ActiveCell.Offset(0, 1).Activate    
Sheets("Лист3").Select    
ActiveSheet.Paste    
Selection.NumberFormat = "0"    
ActiveCell.Offset(0, 1).Activate    
Sheets("Лист1").Select    
If ActiveCell.Column = 5 Then    
Range("B1").Activate    
End If
End Sub

Через стандартные Ctrl+V получаю нужный результат вида 155, без нулей.
Выяснилось, что VBA интерпретирует запятую как разделитель разрядов, точку разделитель дробной части.
Помогите пожалуйста обойти это как-то, чтоб можно было именно макросом пользоваться, т.к. он у меня не только вставкой, а и "прыжками" как можно увидеть активно занимается. Перепробовал множество вариантов, вплоть до сендкея, но к сожалению "прыжки" перестают срабатывать.
Прошу исключительно добровольной макропомощи.
Изменено: Novichok55 - 20.06.2018 00:58:47
Вставка целого числа и разделение его на число с запятой
 
Создаю новую тему. Извините.
Вставка целого числа и разделение его на число с запятой
 
vikttur
если честно, то я не понял ваши вырывания из контекста, на мой взгляд они могут спутать, тех кто бы захотел по доброй воле разобраться в вопросе.

Требуется, чтоб число которое в 1с выглядит как 155,000 (означающее 155 штук) вставлялось через макрос именно как 155, а не 155 000.
Через Ctrl+V нормально всё, но это вручную переходить по листам и каждый раз нажимать.
Вставка целого числа и разделение его на число с запятой
 
Ігор Гончаренко
пример. Вставлено вот таким кодом, числовой столбец. Между тремя нулями и остальным типа пробел убран этим
Код
Selection.NumberFormat = "0"
Код
Sub odins1()
    ActiveSheet.Paste
    Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист2").Select
    ActiveSheet.Paste
    Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист3").Select
    ActiveSheet.Paste
    Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист1").Select
    If ActiveCell.Column = 5 Then
    Range("B1").Activate
    End If
End Sub
Изменено: Novichok55 - 19.06.2018 20:49:19
Вставка целого числа и разделение его на число с запятой
 
Вы же меня знаете, я файлы всегда прикладываю, но на сколько он будет корректен, это ведь уже после свершившейся в Excel вставки я его сохраню.
Смогу только завтра сделать к своему сожалению :(
Вставка целого числа и разделение его на число с запятой
 
Задача. Скопировать три столбца типа таблицы в 1с (копирую поштучно рядом находящиеся столбцы, т.к. в 1 с нет возможности сразу три скопировать).
Далее эти данные попадают в мясорубку макросов. Нужен внешний вид числа именно просто 155, чтоб получился.
Спасибо за разъяснение, что VBA именно так понимает запятую. Это наверно вновь суперзнания нужны, чтоб неким образом обойти это неподходящее для меня понимание.
Или продолжить извращения и преобразовав числа в текст прилепить обрезание правых трех символов :( но я написал сюда именно, чтоб как-то по-нормальному может вариант какой есть.
Изменено: Novichok55 - 18.06.2018 23:46:26
Вставка целого числа и разделение его на число с запятой
 
bedvit
первоначальные данные из выделенного столбца в 1с, кликая по нужному из выделенных столбцов в некоем поле 1с я выбираю Копировать и перехожу в окно Excel.
Сразу сохранить это поле 1с в Excel таблицу не вариант, т.к. коротко говоря внешний_вид/формат, который получается не тот, что мне нужно.
Изменено: Novichok55 - 18.06.2018 23:27:30
Вставка целого числа и разделение его на число с запятой
 
Добрый вечер всем.
Не хочу плодить темы, как мне показалось вопрос в тему. vikttur извините, если я не прав.
Подскажите пожалуйста по такой проблеме.

Простенький макрос для вставки сразу на 3 листа значений из 1с.
Код
Sub odins1()
    ActiveSheet.Paste
    'Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист2").Select
    ActiveSheet.Paste
    'Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист3").Select
    ActiveSheet.Paste
    'Selection.NumberFormat = "0"
    ActiveCell.Offset(0, 1).Activate
    Sheets("Лист1").Select
    If ActiveCell.Column = 5 Then
    Range("B1").Activate
    End If
End Sub
всё вроде бы нормально, пока не доходит дело до вставки числового столбца 1с. В 1с видимый формат 155,000, что означает 155 штук.
Так вот, когда просто стандартное Ctrl+V нормально вставляет 155. Казалось бы записал и всё нормально, но вот через это самое записанное действие
Код
ActiveSheet.Paste
вставляет 155000 или 155 000, т.е. теряется запятая и получаются именно тысячи :(
Какие только извращения, вплоть до SendKeys ("^{v}") я не предпринимал, но ничего не получается, т.к. через сендкей свои ограничения получаются, вроде не копирования на другие листы, не перехода по координатам...
Помогите пожалуйста.
Изменено: Novichok55 - 19.06.2018 20:47:59
Удаление значений внутри ячейки по условию
 
Спасибо большое, что не забыли обо мне, альтернативный вариант работает :) Проверил как только мог.
Отдельно спасибо за пояснение, хотя бы отдаленно можно поинтересоваться, что да как.
Удаление значений внутри ячейки по условию
 
Kuzmich
Протестировал. Работает, но результат первых двух ячеек - пустые ячейки, даже если это просто полностью зачеркнутые ячейки изначально, включая само наименование (те которые вообще не обрабатываются). А дальше всё именно так как нужно, начиная с 3й строки.
Запускаю макрос, когда уже всё зачищено, одна пустая ячейка между типа блоками, нет одиночных жирных, остаются не удаленные "не_зачеркнутые" и не посчитано вычитание для случаев со скобками.
Если искусственно сместить, начало данных которые нужно обработать на 3ю строку, то всё OK.

Вот тут я так понимаю на A1 нужно сменить.
Код
Range("A3:A" & iLastRow).Copy Range("D3") 'копируем исходный диапазон в столбец D
Помогло.
Щяс на большом количестве проверю.
Изменено: Novichok55 - 31.05.2018 21:14:57
Удаление значений внутри ячейки по условию
 
Kuzmich
Спасибо. Я имел ввиду, что именно в коде VBA не могу вычислить, как описаны эти частные случаи, о чем речь я конечно же понял сразу.
После этого варианта макроса SAS888 частный случай оказывается совсем не зачеркнутым и не пригоден к вашему макросу на удаление всего не_зачеркнутого :( он его удаляет.
Но на исправление даже я оказался способен ситуации, добавил
Код
z.Characters(a(i), Len(Split(y.Item(i), "-")(0)) + Len(b(i)) + 1).Font.Strikethrough = True
и было подумал, что альтернативный путь готов, но после вашего макроса, на удаление не_зачеркнутого, курсив теряется.
Удаление значений внутри ячейки по условию
 
Цитата
Kuzmich написал:
После макроса SAS888 в этих частных случаях зачеркнутыми являются только цифры. Этот признак и можно использоватьдля выделения этих частных курсивом
Я этот момент конечно помню, и думал о нем, но написать такое вряд ли в VBA сумею, даже на базе уже сделанного вами макроса. Глядя на ваш макрос, даже просто не понимаю в какой его строке описаны эти самые частные случаи :(
Удаление значений внутри ячейки по условию
 
Я так и не пойму, нужно ли coll объявить наверху
Код
Dim coll As Collection, y
или нет. В теме про удаление жирной, если следующая пустая мне давали разъяснение в котором рекомендуется всегда ставить в самом верху макроса Option Explicit, чтоб оно отлавливало не объявленные переменные.
Тут же я не пойму, раз RAN не писал об этом я не объявляю, но если добавляю Option Explicit ругает coll сразу же.

vikttur
спасибо. Заработало. Одного Next не хватало для второго вами указанного фрагмента.
Изменено: Novichok55 - 29.05.2018 20:07:05
Удаление значений внутри ячейки по условию
 
RAN
спасибо, что сжалились. Прошу прощения у всех за надругательство над VBA в моем исполнении.

Добавил строки, которые вы подсказали, ругается на End With
Код
Sub мяу2()
    Dim i&, ii&
    Dim s$, ss$
    Dim objRegExp As Object, oMatches As Object
    Dim r As Range
    Dim col As Collection, x
    Set r = Selection
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True: objRegExp.IgnoreCase = False: objRegExp.MultiLine = False
    Application.ScreenUpdating = False
    For ii = r.Rows.Count To 1 Step -1
        If r(ii, 1).Font.Bold = True Then
            If IsEmpty(r(ii, 1).Offset(1)) Then r(ii, 1).EntireRow.Delete
        Else
            If r(ii, 1).Font.Strikethrough Then
            ElseIf r(ii, 1).Font.Strikethrough = False Then
                If Len(r(ii, 1)) Then r(ii, 1).EntireRow.Delete
            Else
                With r(ii, 1)
                    s = .Value
                    objRegExp.Pattern = " [A-Z/]+-\d+"
                    If objRegExp.test(s) Then
                        Set oMatches = objRegExp.Execute(s)
                        Set col = New Collection
                        Set coll = New Collection
                        For i = 0 To oMatches.Count - 1
                            If .Characters(oMatches(i).firstindex + 2, 1).Font.Strikethrough = False Then
                                col.Add oMatches(i).Value, oMatches(i).Value
                            End If
                        Next
                    End If
                    objRegExp.Pattern = "( [A-Z/]+)(-\d+) (\(\d+\))"
                    Set oMatches = objRegExp.Execute(s)
                    For i = 0 To oMatches.Count - 1
                        ss = oMatches(i).SubMatches(0) & -oMatches(i).SubMatches(1) - (Replace(Replace(oMatches(i).SubMatches(2), ")", ""), "(", ""))
                        On Error Resume Next
                        col.Remove ss
                        coll.Add ss, ss
                        On Error GoTo 0
                        s = Replace(s, oMatches(i), ss)
                    Next
                    For Each x In col
                        s = Replace(s, x, "")
                    Next
                    .Value = Trim(s)
                    objRegExp.Pattern = " [A-Z/]+-\d+"
                    Set oMatches = objRegExp.Execute(s)
                    For i = 0 To oMatches.Count - 1
                        .Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Strikethrough = True
                    For Each x In coll
                            If oMatches(i) = x Then .Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Color = vbRed
                            If oMatches(i) = x Then .Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Italic = True
                    Next
                End With
             End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
на это и при моих экспериментах часто выкидывало.
Это свое произведение
Код
Dim coll As Collection, y
не объявлял наверху.
Изменено: Novichok55 - 29.05.2018 19:38:16
Удаление значений внутри ячейки по условию
 
RAN
я в правильном направлении двигаюсь? Похоже, что вообще не то.
Код
Sub мяу()
    Dim i&, ii&
    Dim s$, ss$
    Dim objRegExp As Object, oMatches As Object
    Dim r As Range
    Dim col As Collection, x
    Dim coll As Collection, y
    Set r = Selection
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True: objRegExp.IgnoreCase = False: objRegExp.MultiLine = False
    Application.ScreenUpdating = False
    For ii = r.Rows.Count To 1 Step -1
        If r(ii, 1).Font.Bold = True Then
            If IsEmpty(r(ii, 1).Offset(1)) Then r(ii, 1).EntireRow.Delete
        Else
            If r(ii, 1).Font.Strikethrough Then
            ElseIf r(ii, 1).Font.Strikethrough = False Then
                If Len(r(ii, 1)) Then r(ii, 1).EntireRow.Delete
            Else
                With r(ii, 1)
                    s = .Value
                    objRegExp.Pattern = " [A-Z/]+-\d+"
                    If objRegExp.test(s) Then
                        Set oMatches = objRegExp.Execute(s)
                        Set col = New Collection
                        For i = 0 To oMatches.Count - 1
                            If .Characters(oMatches(i).firstindex + 2, 1).Font.Strikethrough = False Then
                                col.Add oMatches(i).Value, oMatches(i).Value
                            End If
                        Next
                    End If
                    objRegExp.Pattern = "( [A-Z/]+)(-\d+) (\(\d+\))"
                    Set oMatches = objRegExp.Execute(s)
                    For i = 0 To oMatches.Count - 1
                        ss = oMatches(i).SubMatches(0) & -oMatches(i).SubMatches(1) - (Replace(Replace(oMatches(i).SubMatches(2), ")", ""), "(", ""))
                        On Error Resume Next
                        col.Remove ss
                        On Error GoTo 0
                        s = Replace(s, oMatches(i), ss)
                    Next
                    For Each x In col
                        s = Replace(s, x, "")
                    Next
                    .Value = Trim(s)
                    objRegExp.Pattern = " [A-Z/]+-\d+"
                    Set oMatches = objRegExp.Execute(s)
                    For i = 0 To oMatches.Count - 1
                        .Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Strikethrough = True
                    Next
                    objRegExp.Pattern = "( [A-Z/]+)(-\d+) (\(\d+\))"
                    Set oMatches = objRegExp.Execute(s)
                    Set coll = New Collection
                    For i = 0 To oMatches.Count - 1
                        ss = oMatches(i).SubMatches(0) & -oMatches(i).SubMatches(1) - (Replace(Replace(oMatches(i).SubMatches(2), ")", ""), "(", ""))
                        On Error Resume Next
                        coll.Remove ss
                        On Error GoTo 0
                        s = Replace(s, oMatches(i), ss)
                    Next
                    For Each x In coll
                        s = Replace(s, x, "")
                    Next
                    .Value = Trim(s)
                    objRegExp.Pattern = " [A-Z/]+-\d+"
                    Set oMatches = objRegExp.Execute(s)
                    For i = 0 To oMatches.Count - 1
                        .Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Italic = True
                    Next
                End With
 
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
проходит без ошибок, но явно мне кажется, что я не создал новую коллекцию для отмечания только частных случаев курсивом :( Потому как получается тоже , что и с просто вашим "мяу" добавив одну строку про italic.
Читаю вот это http://www.interface.ru/home.asp?artId=16288

Похоже полный бред и совать паттерн ищущий со скобками не нужно, на момент когда подходит время задать стиль оно уже приняло обычный вид после вычитания.
Нужно я так понимаю, отдельно проделать коллекцию для стандартных зачеркнутых и отдельно коллекцию для полученных вычитанием. По той статье тольком не поймешь, как вторую коллекцию задать :(
Изменено: Novichok55 - 29.05.2018 00:15:20
Удаление значений внутри ячейки по условию
 
Kuzmich
спасибо. Но меня интересуют именно те случаи, которые я называл частные, когда от скобки справа вычитание делалось. Всё остальное меня устраивает, только частные как-то пометить хочется, курсив я посчитал лучшее будет для моего случая. Полученное я всегда печатаю на черно-белом принтере и работаю в бумажном виде.
В любом случае большое спасибо, макрос ещё гибче стал, можно строку цвета для задания размера шрифта перечеркнутого использовать.
Удаление значений внутри ячейки по условию
 
RAN
спасибо. Я уже понял, буду стараться раз вы считает что я и сам смогу, надеюсь получится выстроить правильно конструктор вашего макроса, чтоб нужной мне части присвоить ещё и italic :) или наоборот отделить её от той которая просто зачеркнута. Это вставить под то что уже есть
Код
.Characters(oMatches(i).firstindex + 2, oMatches(i).Length - 1).Font.Italic = True
я конечно же попробовал, результат понятно не тот, но и не совсем как макросе Kuzmich.
Изменено: Novichok55 - 28.05.2018 21:47:21
Удаление значений внутри ячейки по условию
 
Не соображу, извините, о какой коллекции речь?
Удаление значений внутри ячейки по условию
 
RAN
извините, не очень вас понял, но к сожалению чисто интуитивное впечатление, что вы на меня обиделись, что я опять что-то придумываю? Мне как бы действительно неплохо бы знать сразу, это просто изначально зачеркнутая или из вычитания позиция. В примере сразу про это не сказал, но всего сразу ну никак, это вызревает в процессе, когда уже есть то что в примере хотел :(
В сообщении максимально пытался дать понять, что только если будет желание и это не целое дело.
Изменено: Novichok55 - 28.05.2018 20:11:23
Удаление значений внутри ячейки по условию
 
Kuzmich
RAN
извините пожалуйста, боюсь попросить, но вынужден. Нельзя ли, добавить, чтоб то что получено вычитанием, кроме того что оно щяс зачеркнуто, было ещё и курсивом.
Kuzmich то что было полузачеркнутым, щяс как бы аккуратнее, но не отличается от обычного зачеркнутого. Понял, что на практике мне бы такая помеченность курсивом для этих полученных вычитанием для понимания очень бы не помешала  :oops: Курсив намного нагляднее полузачекнутости.

Если только это не целое дело, честное слово, совершенно не представляю в рамках этих макросов как оно.
Сам попробовал в вашем Kuzmich под строкой
Код
Cells(i, 2).Characters(InStr(1, Cells(i, 2), a(j)), Len(a(j))).Font.Strikethrough = True
вставить
Код
Cells(i, 2).Characters(InStr(1, Cells(i, 2), a(j)), Len(a(j))).Font.Italic = True
оно все размеры, что обрабатывались и даже строки, что просто полностью были перечекнуты и не трогались вывело курсивом :( больше я не вижу, где там можно пристоиться.
Изменено: Novichok55 - 28.05.2018 19:26:31
Удаление значений внутри ячейки по условию
 
Kuzmich
большое спасибо. Протестировал на немалом количестве материала, вроде всё отлично, ещё и полностью зачеркивает теперь всё.

RAN
приятно обескуражили, столько тем и страстей и вот он высший пилотаж. Всё в одном и работает. Огромное спасибо.
Удаление значений внутри ячейки по условию
 
:oops:  просто не догадываешься, что столько коварства вокруг :(
Удаление значений внутри ячейки по условию
 
Попроверял как мог, в целом работает вся система. Но нашлось сочетание  которое не нравится макросу на удаление не_зачеркнутого, строка 4 в  примере.
Когда в названии следующего за зачернутым размером буква такая же как у предыдущего зачеркнутого (или последняя из букв) плюс у них число одинаковое, такое сочетание на рабочем материале очень часто бывает :(
Удаление значений внутри ячейки по условию
 
Именно в нем и проверяю. Выделяю в столбце A диапазон и запускаю.

Кажется, не слетело с того, с чего не нужно :) Спасибо. Щяс протестирую. Но если всё так, то данные к вашему макросу на удаление "всё не зачеркнутое" готовы.
Получается оно "посматривает" на столбец A, как там было, ого...
Изменено: Novichok55 - 27.05.2018 00:01:56
Удаление значений внутри ячейки по условию
 
Ругаясь на
Код
If InStr(1, z.Offset(, -3), a(i)) > 0 Then
всё же проводит процедуру вычитания, но в строке 6 происходит, то от чего всё это, с m88 слетает зачеркивание и оно будет удалено вашим макросом, удаляющим всё не зачеркнутое.
Страницы: 1 2 3 4 След.
Наверх