Здравствуйте. Подскажите пожалуйста формулу. Задача следующая: Есть справочник значений из 2-х столбцов откуда брать данные (A1(на английском), Б1(на русском)). Столбец "C1" содержит значения через запятую из столбца А1. Нужно в столбце "E1", отобразить те же значения через запятую из столбца С1, только на русском (т.е. брать значения из столбца "Б1"). Файлик примера прикрепил.
Информация объемная, нужна формула однозначно!
Буду очень благодарен за отклик.
Здравствуйте. Подскажите пожалуйста формулу. Задача следующая: Есть справочник значений из 2-х столбцов откуда брать данные (A1(на английском), Б1(на русском)). Столбец "C1" содержит значения через запятую из столбца А1. Нужно в столбце "E1", отобразить те же значения через запятую из столбца С1, только на русском (т.е. брать значения из столбца "Б1"). Файлик примера прикрепил.
Function JIexa74(txt As String) As String txt = Replace(txt, " ", ",", 1, 1) arr = Split(txt, ",") For i = 0 To UBound(arr) With Application: arr(i) = .IfError(.Index(Range("B:B"), .Match(.Trim(arr(i)), Range("A:A"), 0)), ""): End With Next JIexa74 = Replace(Join(arr, ", "), ",", "", 1, 1) End Function
[/vba]
вариант пользовательской функцией [vba]
Код
Function JIexa74(txt As String) As String txt = Replace(txt, " ", ",", 1, 1) arr = Split(txt, ",") For i = 0 To UBound(arr) With Application: arr(i) = .IfError(.Index(Range("B:B"), .Match(.Trim(arr(i)), Range("A:A"), 0)), ""): End With Next JIexa74 = Replace(Join(arr, ", "), ",", "", 1, 1) End Function
sboy, честно, не думал что можно это все так организовать.
Задача немного усложнилась. Можете помочь написать макрос для такой задачи. В документе в принципе все расписал. примеры даны. В долгу не останусь!
sboy, честно, не думал что можно это все так организовать.
Задача немного усложнилась. Можете помочь написать макрос для такой задачи. В документе в принципе все расписал. примеры даны. В долгу не останусь!JIexa_74
Dim R As Range RC = Range("C2").End(xlDown).Row Set R = Range(Cells(2, 5), Cells(RC, 5)) For i = 2 To RC Cells(i, 5).Value = Replace(Cells(i, 3).Value & ",", " ", "#") Next i For i = 1 To Range("A1").End(xlDown).Row R.Replace What:=Replace(UCase(Cells(i, 1).Value), " ", "#"), Replacement:=Replace(Cells(i, 2).Value, " ", "#"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False R.Replace What:=UCase(Cells(i, 1).Value) & ",", Replacement:=Cells(i, 2).Value & ",", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False
Next i For i = 2 To RC Cells(i, 5).Value = Replace(Left(Cells(i, 5).Value, Len(Cells(i, 5).Value) - 1), "#", " ") Next i
End Sub
[/vba]
И, да, если Вы действительно готовы оплатить работу специалиста, то сделайте всё цивилизованно - разместите пост в разделе Работа/Фриланс и проведите переговоры в ЛС о работе/сроках/оплате с первым из откликнувшихся в этой теме экспертов.
А "в долгу не останусь" - это слишком абстрактно и мало что добавляет к мотивации (помочь мы можем и без морковки)
Посмотрите, так заменяет MARK II ?
[vba]
Код
Public Sub Transfer()
Dim R As Range RC = Range("C2").End(xlDown).Row Set R = Range(Cells(2, 5), Cells(RC, 5)) For i = 2 To RC Cells(i, 5).Value = Replace(Cells(i, 3).Value & ",", " ", "#") Next i For i = 1 To Range("A1").End(xlDown).Row R.Replace What:=Replace(UCase(Cells(i, 1).Value), " ", "#"), Replacement:=Replace(Cells(i, 2).Value, " ", "#"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False R.Replace What:=UCase(Cells(i, 1).Value) & ",", Replacement:=Cells(i, 2).Value & ",", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False
Next i For i = 2 To RC Cells(i, 5).Value = Replace(Left(Cells(i, 5).Value, Len(Cells(i, 5).Value) - 1), "#", " ") Next i
End Sub
[/vba]
И, да, если Вы действительно готовы оплатить работу специалиста, то сделайте всё цивилизованно - разместите пост в разделе Работа/Фриланс и проведите переговоры в ЛС о работе/сроках/оплате с первым из откликнувшихся в этой теме экспертов.
А "в долгу не останусь" - это слишком абстрактно и мало что добавляет к мотивации (помочь мы можем и без морковки)abtextime
Dim R As Range RC = Range("J3").End(xlDown).Row Set R = Range(Cells(2, 12), Cells(RC, 12)) For i = 3 To RC Cells(i, 12).Value = UCase(Replace(Replace(Cells(i, 1).Value, " ", "#"), ",", "$") & "#НА#" & Replace(Cells(i, 9).Value & " " & Cells(i, 10).Value, " ", "#") & " " & Replace(Cells(i, 11).Value, ",", "$")) & "," Next i
For i = 3 To Range("A3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 1).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 2).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("F3").End(xlDown).Row R.Replace What:=UCase(Cells(i, 6).Value) & ",", Replacement:=Cells(i, 7).Value & "$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("D3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 4).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 5).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To RC Cells(i, 12).Value = Replace(Replace(Left(Cells(i, 12).Value, Len(Cells(i, 12).Value) - 1), "#", " "), "$", ",") Next i
End Sub
[/vba]
JIexa_74,
Посмотрите, всё ли правильно
[vba]
Код
PPublic Sub Transfer()
Dim R As Range RC = Range("J3").End(xlDown).Row Set R = Range(Cells(2, 12), Cells(RC, 12)) For i = 3 To RC Cells(i, 12).Value = UCase(Replace(Replace(Cells(i, 1).Value, " ", "#"), ",", "$") & "#НА#" & Replace(Cells(i, 9).Value & " " & Cells(i, 10).Value, " ", "#") & " " & Replace(Cells(i, 11).Value, ",", "$")) & "," Next i
For i = 3 To Range("A3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 1).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 2).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("F3").End(xlDown).Row R.Replace What:=UCase(Cells(i, 6).Value) & ",", Replacement:=Cells(i, 7).Value & "$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("D3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 4).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 5).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To RC Cells(i, 12).Value = Replace(Replace(Left(Cells(i, 12).Value, Len(Cells(i, 12).Value) - 1), "#", " "), "$", ",") Next i
Function JIexa74(r As Range) As String If r.Count <> 4 Then Exit Function With Application JIexa74 = .IfError(.Index(Range("B:B"), .Match(r.Cells(1), Range("A:A"), 0)), "") & " ÍÀ " JIexa74 = JIexa74 & .IfError(.Index(Range("E:E"), .Match(r.Cells(2), Range("D:D"), 0)), "") arr = Split(r.Cells(3), ",") For i = 0 To UBound(arr) arr(i) = .IfError(.Index(Range("E:E"), .Match(.Trim(arr(i)), Range("D:D"), 0)), "") Next JIexa74 = JIexa74 & Join(arr, ", ") JIexa74 = JIexa74 & .IfError(.Index(Range("G:G"), .Match(r.Cells(4), Range("F:F"), 0)), "") End With End Function
[/vba]
По файлу из сообщения 9 [vba]
Код
Function JIexa74(r As Range) As String If r.Count <> 4 Then Exit Function With Application JIexa74 = .IfError(.Index(Range("B:B"), .Match(r.Cells(1), Range("A:A"), 0)), "") & " ÍÀ " JIexa74 = JIexa74 & .IfError(.Index(Range("E:E"), .Match(r.Cells(2), Range("D:D"), 0)), "") arr = Split(r.Cells(3), ",") For i = 0 To UBound(arr) arr(i) = .IfError(.Index(Range("E:E"), .Match(.Trim(arr(i)), Range("D:D"), 0)), "") Next JIexa74 = JIexa74 & Join(arr, ", ") JIexa74 = JIexa74 & .IfError(.Index(Range("G:G"), .Match(r.Cells(4), Range("F:F"), 0)), "") End With End Function
Поправил (результат на листе "Результат работы макроса") [vba]
Код
Public Sub Transfer()
Dim R As Range RC = Range("J3").End(xlDown).Row Set R = Range(Cells(2, 12), Cells(RC, 12)) For i = 3 To RC Cells(i, 12).Value = UCase(Replace(Replace(Cells(i, 1).Value, " ", "#"), ",", "$") & "#НА#" & Replace(Cells(i, 9).Value & " " & Cells(i, 10).Value, " ", "#") & " " & Replace(Cells(i, 11).Value, ",", "$")) & "$" Next i
For i = 3 To Range("A3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 1).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 2).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("F3").End(xlDown).Row R.Replace What:=UCase(Cells(i, 6).Value) & "$", Replacement:=Cells(i, 7).Value & "$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("D3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 4).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 5).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To RC Cells(i, 12).Value = Replace(Replace(Left(Cells(i, 12).Value, Len(Cells(i, 12).Value) - 1), "#", " "), "$", ",") Next i
End Sub
[/vba]
Это не функция, как у коллеги sboy, а макрос (Procedure). Его надо не вставлять в ячейки. а запускать его с вкладки Разработчик (можно на комбинацию клавиш "повесить"
Поправил (результат на листе "Результат работы макроса") [vba]
Код
Public Sub Transfer()
Dim R As Range RC = Range("J3").End(xlDown).Row Set R = Range(Cells(2, 12), Cells(RC, 12)) For i = 3 To RC Cells(i, 12).Value = UCase(Replace(Replace(Cells(i, 1).Value, " ", "#"), ",", "$") & "#НА#" & Replace(Cells(i, 9).Value & " " & Cells(i, 10).Value, " ", "#") & " " & Replace(Cells(i, 11).Value, ",", "$")) & "$" Next i
For i = 3 To Range("A3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 1).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 2).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("F3").End(xlDown).Row R.Replace What:=UCase(Cells(i, 6).Value) & "$", Replacement:=Cells(i, 7).Value & "$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To Range("D3").End(xlDown).Row R.Replace What:=Replace(Replace(UCase(Cells(i, 4).Value), " ", "#"), ",", "$"), Replacement:=Replace(Replace(Cells(i, 5).Value, " ", "#"), ",", "$"), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i
For i = 3 To RC Cells(i, 12).Value = Replace(Replace(Left(Cells(i, 12).Value, Len(Cells(i, 12).Value) - 1), "#", " "), "$", ",") Next i
End Sub
[/vba]
Это не функция, как у коллеги sboy, а макрос (Procedure). Его надо не вставлять в ячейки. а запускать его с вкладки Разработчик (можно на комбинацию клавиш "повесить"
Еще один момент, в колонке "L3" не переименовывается "COROLLA WAGON", в "КОРОЛЛА ВАГОН" и в колонке "L4", не переименовывается "MARK II BLIT" в "МАРК 2 БЛИТ".
Скажите а по мере добавление справочника данный макрос будет автоматически считывать значения? Или вручную как то менять....потому что справочник будет наполняться постепенно. В файлике ничего не менял. Можете взять предыдущий.
Спасибо.
abtextime, супер.
Еще один момент, в колонке "L3" не переименовывается "COROLLA WAGON", в "КОРОЛЛА ВАГОН" и в колонке "L4", не переименовывается "MARK II BLIT" в "МАРК 2 БЛИТ".
Скажите а по мере добавление справочника данный макрос будет автоматически считывать значения? Или вручную как то менять....потому что справочник будет наполняться постепенно. В файлике ничего не менял. Можете взять предыдущий.
sboy, не видел, извините, сейчас ознакомился. 1. в результате не хватает пробелов, обратите внимание. 2. имя товара, марка, модель норм "превращается". А вот по ДВС, если одно значение, например "1NZFE", то на выходе "1NZFE, 1NZ-FE, 1NZ (1.5)", НО, если в ДВС будет, "1NZFE, 1GFE, 2UZFE", то в результате пусто. "
sboy, не видел, извините, сейчас ознакомился. 1. в результате не хватает пробелов, обратите внимание. 2. имя товара, марка, модель норм "превращается". А вот по ДВС, если одно значение, например "1NZFE", то на выходе "1NZFE, 1NZ-FE, 1NZ (1.5)", НО, если в ДВС будет, "1NZFE, 1GFE, 2UZFE", то в результате пусто. "JIexa_74
WAGON у Вас нет в столбце D. Если будет - "переведет"
MARK II BLIT - из-за того, что есть MARK II, он "сбивает". можно заменить пару "MARK II BLIT - МАРК 2 БЛИТ" на "BLIT - БЛИТ" и замена отработает (см. приложенный файл). Вообще, макрос был бы проще, если бы в столбце были ТОЛЬКО СЛОВА, а не СЛОВА и СОЧЕТАНИЯ СЛОВ. Это же возможно и, в общем-то, разумно
JIexa_74,
WAGON у Вас нет в столбце D. Если будет - "переведет"
MARK II BLIT - из-за того, что есть MARK II, он "сбивает". можно заменить пару "MARK II BLIT - МАРК 2 БЛИТ" на "BLIT - БЛИТ" и замена отработает (см. приложенный файл). Вообще, макрос был бы проще, если бы в столбце были ТОЛЬКО СЛОВА, а не СЛОВА и СОЧЕТАНИЯ СЛОВ. Это же возможно и, в общем-то, разумноabtextime