У меня в ячейке каждый раз высвечиваются разные предложения, но все они содержат одну и ту же часть : Базовая ставка таможенной пошлины: + число (например Базовая ставка таможенной пошлины: 10%)
Помогите написать макрос, который по событию изменения предложений в ячейке D1 будет записывать эту часть, которую указал выше в ячейку B1. Например у нас в ячейке D1 появилось предложение : Части машин, агрегатов и оборудования прочие. 9: Части машин, агрегатов и оборудования прочие. Базовая ставка таможенной пошлины: 0, НДС, акциз, меры нетарифного регулирования. ТН ВЭД онлайн — товарная номенклатура внешнеэкономической , НДС
и как только оно появилось мы вставляем в ячейку B1 Базовая ставка таможенной пошлины: 0
У меня в ячейке каждый раз высвечиваются разные предложения, но все они содержат одну и ту же часть : Базовая ставка таможенной пошлины: + число (например Базовая ставка таможенной пошлины: 10%)
Помогите написать макрос, который по событию изменения предложений в ячейке D1 будет записывать эту часть, которую указал выше в ячейку B1. Например у нас в ячейке D1 появилось предложение : Части машин, агрегатов и оборудования прочие. 9: Части машин, агрегатов и оборудования прочие. Базовая ставка таможенной пошлины: 0, НДС, акциз, меры нетарифного регулирования. ТН ВЭД онлайн — товарная номенклатура внешнеэкономической , НДС
и как только оно появилось мы вставляем в ячейку B1 Базовая ставка таможенной пошлины: 0Oh_Nick
Написал вот такой макрос, но он не очень удобен за счет того, что предложения каждый раз разные по символам + если брать количество символов, то он может обрезать число, т.к 0 пишется без знака % (например Базовая ставка таможенной пошлины: 0 , но Базовая ставка таможенной пошлины: 10%) и т.д
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range
Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Mid(cell.Value, InStr(cell.Value, ":") + 48, 38) Else Range("B1").Value = "Отрезок не найден" End If End If End Sub
[/vba]
Написал вот такой макрос, но он не очень удобен за счет того, что предложения каждый раз разные по символам + если брать количество символов, то он может обрезать число, т.к 0 пишется без знака % (например Базовая ставка таможенной пошлины: 0 , но Базовая ставка таможенной пошлины: 10%) и т.д
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range
Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Mid(cell.Value, InStr(cell.Value, ":") + 48, 38) Else Range("B1").Value = "Отрезок не найден" End If End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range: Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
' Вычисляем значение формулы Dim formulaResult As Variant: formulaResult = Application.Evaluate(Range("D1").Formula)
If Not cell Is Nothing Then Range("B1").Value = Mid(formulaResult, InStr(formulaResult, ":") + 48, 38) Else Range("B1").Value = "Отрезок не найден" End If
End If
End Sub
[/vba] Не проверено на файле, проверяйте.
Oh_Nick, И вам Здрасьте. Может так: [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range: Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
' Вычисляем значение формулы Dim formulaResult As Variant: formulaResult = Application.Evaluate(Range("D1").Formula)
If Not cell Is Nothing Then Range("B1").Value = Mid(formulaResult, InStr(formulaResult, ":") + 48, 38) Else Range("B1").Value = "Отрезок не найден" End If
у меня в ячейке D1 формула, которая выдает это предложение
И где эта формула в файле? Файл пример не годится! Ну а так исходя из того что я увидил в вашем фале, то вот следуйщий код: [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cellValue As String: cellValue = Range("D1").Value Dim cell As Range: Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Mid(cellValue, InStr(cellValue, ":") + 48, 36) Else Range("B1").Value = "Отрезок не найден" End If
у меня в ячейке D1 формула, которая выдает это предложение
И где эта формула в файле? Файл пример не годится! Ну а так исходя из того что я увидил в вашем фале, то вот следуйщий код: [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cellValue As String: cellValue = Range("D1").Value Dim cell As Range: Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Mid(cellValue, InStr(cellValue, ":") + 48, 36) Else Range("B1").Value = "Отрезок не найден" End If
Попробовал вот такой вариант, но почему то снова не хочет ничего:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range
Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Trim(Left(cell.Value, Len(cell.Value) - Len(Split(cell.Value, ":")(0)))) 'извлечение числа после двоеточия
If IsNumeric(Range("B1").Value) Then Range("B1").Value = Range("B1").Value & "%" End If Else Range("B1").Value = "Отрезок не найден" End If End If End Sub
[/vba]
Попробовал вот такой вариант, но почему то снова не хочет ничего:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D1")) Is Nothing Then Dim cell As Range
Set cell = Range("D1").Find("Базовая ставка таможенной пошлины:*")
If Not cell Is Nothing Then Range("B1").Value = Trim(Left(cell.Value, Len(cell.Value) - Len(Split(cell.Value, ":")(0)))) 'извлечение числа после двоеточия
If IsNumeric(Range("B1").Value) Then Range("B1").Value = Range("B1").Value & "%" End If Else Range("B1").Value = "Отрезок не найден" End If End If End Sub
Oh_Nick, Кстатите, если вставите в A1 7326909409 то в B1 появляется значение 10 это и есть сегодняшняя ставка по сайту. Код из поста #9 от mgt, рабочий.
Oh_Nick, Кстатите, если вставите в A1 7326909409 то в B1 появляется значение 10 это и есть сегодняшняя ставка по сайту. Код из поста #9 от mgt, рабочий.MikeVol
Pelena, а если у меня в колонке несколько кодов, я могу писать так или это неверно? А то я написал и у меня везде высветилось *Отрезок не найден*
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2:E350")) Is Nothing Then Application.EnableEvents = False frm = Range("P2:P350").Text If frm <> "" Then If InStr(frm, "Базовая ставка таможенной пошлины:") > 0 Then frm = Mid(frm, InStr(frm, "Базовая ставка таможенной пошлины:") + Len("Базовая ставка таможенной пошлины:")) Else Range("F2:F350").Value = "Нет данных" End If
Range("F2:F350").Value = Trim(Split(frm, ",")(0)) 'извлечение числа после двоеточия до запятой
If Range("F2:F350").Value = "" Then Range("F2:F350").Value = "Нет данных"
Else Range("F2:F350").Value = "Отрезок не найден" End If Application.EnableEvents = True End If End Sub
[/vba]
Pelena, а если у меня в колонке несколько кодов, я могу писать так или это неверно? А то я написал и у меня везде высветилось *Отрезок не найден*
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2:E350")) Is Nothing Then Application.EnableEvents = False frm = Range("P2:P350").Text If frm <> "" Then If InStr(frm, "Базовая ставка таможенной пошлины:") > 0 Then frm = Mid(frm, InStr(frm, "Базовая ставка таможенной пошлины:") + Len("Базовая ставка таможенной пошлины:")) Else Range("F2:F350").Value = "Нет данных" End If
Range("F2:F350").Value = Trim(Split(frm, ",")(0)) 'извлечение числа после двоеточия до запятой
If Range("F2:F350").Value = "" Then Range("F2:F350").Value = "Нет данных"
Else Range("F2:F350").Value = "Отрезок не найден" End If Application.EnableEvents = True End If End Sub
Pelena, понял, спасибо! Но теперь я столкнулся с другой проблемой, проверял коды и вдруг высветилось вот так (скриншот приложил). С чем это может быть связано?
Pelena, понял, спасибо! Но теперь я столкнулся с другой проблемой, проверял коды и вдруг высветилось вот так (скриншот приложил). С чем это может быть связано?Oh_Nick
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
