Страницы: Пред. 1 2
RSS
Пометка маркерами фраз по карте словоформ, переделка макроса из OpenOffice для Excel
 
Цитата
Fsociety_ написал:
в оригинале вроде ищет по первой части слова, точно не проверял, но по идее так должно было быть.
не знаю, что по идее должно быть, но
Код
InStr(LCase(Core.Cells(I, 1)), LCase(Keys(J))) 
ищет по всей строке
Изменено: bigorq - 17.04.2019 19:09:09
 
Fsociety_, пробуйте
Код
Sub Fs()
Dim i&, j&, n&
  n = Cells(Rows.Count, 1).End(xlUp).Row - 1
  With Sheets("Карта")
    For i = 1 To .Cells(.Columns.Count).End(xlToLeft).Column Step 2
      j = .Cells(.Rows.Count, i).End(xlUp).Row
      Cells(1, i \ 2 + 2) = .Cells(1, i)
      Cells(2, i \ 2 + 2).Resize(n).FormulaR1C1 = Replace(Replace(Replace( _
        "=IFERROR(LOOKUP(2,1/SEARCH("" ""&Карта!R2C_i_:R_j_C_i_,"" ""&RC1),Карта!R2C_i+1_:R_j_C_i+1_),"""")" _
        , "_i_", i), "_i+1_", i + 1), "_j_", j)
    Next
  End With
  With ActiveSheet.UsedRange: .Value = .Value: End With
End Sub
 
Цитата
"доперевести" макрос до поиска по первой части слов
поменять 43 сроку на

Код
If InStr(LCase(Core.Cells(I, 1)), LCase(Keys(J))) = 1 Or InStr(LCase(Core.Cells(I, 1)), " " & LCase(Keys(J))) > 0 Then

Хотя у  Казанский  вариант короче и красивше

Изменено: bigorq - 17.04.2019 20:07:13
 
bigorq, бьет ошибку с этой строкой
 
Казанский, почему вы так формулы любите?) если вдруг диапазон нужно поменять, и еще какие то значения, то придется и формулу переписывать в макросе
 
Цитата
Fsociety_ написал:  Казанский , почему вы так формулы любите?)
Отвечу за коллегу по цеху:
Потому что сперва были формулы, и только потом VBA,
Потому что в умелых руках формулы творят чудеса, а в неумелых VBA гробит все
Потому что если посмотреть, то формула автоподстраивается под диапазон.
Потому что если что надо поменять то код VBA тоже менять.
По вопросам из тем форума, личку не читаю.
 
Цитата
Fsociety_ написал: бьет ошибку с этой строкой
Заменил. Прошлая из OpenOffice была
 
теперь следующую строку показывает как ошибку =)
Код
Core.Cells(I, CellIndex) = Names(J)
Изменено: Fsociety_ - 18.04.2019 00:35:13
 
У  меня нормально отрабатывает все вот кусок с циклом, проверьте
Код
For J = 1 To NumMarks
         If InStr(LCase(Core.Cells(I, 1)), LCase(Keys(J))) = 1 Or InStr(LCase(Core.Cells(I, 1)), " " & LCase(Keys(J))) > 0 Then
            Core.Cells(I, CellIndex) = Names(J)
         End If
Next J
 
bigorq, странно, поставил ваш код и старый рядом, абсолютно идентичны, но ваш работает почему то)) Спасибо большое за проделанную работу!
 
Цитата
Fsociety_ написал:
почему вы так формулы любите?
Я люблю то, что эффективно в конкретном случае. Здесь формула заменила два вложенных цикла. Код в разы короче и работает на ~40% быстрее. Если будете обрабатывать большие объемы данных - заметите.
Цитата
Fsociety_ написал:
если вдруг диапазон нужно поменять
Какой именно? Все вычисляется в VBA и подставляется в формулу.
А вот если допустим на листе Ядро таблица начинается не с А1, а с В3 - Вы сразу сообразите, что надо поменять в макросе bigorq?
 
Казанский, Я почему то был приверженцем того что с формулами все гораздо дольше работает, не знал что в макросе их можно так грамотно отыгрывать. Даже на небольшом объеме данных видна разница в работе. Спасибо и Вам за проделанную работу. Буду пока оба варианта пробовать и тестировать)
Цитата
Казанский написал:
Вы сразу сообразите, что надо поменять в макросе  bigorq ?
не сразу но соображу) пару минут уйдет
 
Цитата
Казанский написал:
заменила два вложенных цикла. Код в разы короче и работает на ~40% быстрее.
А зачем? Не проще ли свести задачу к бинарному поиску. Будет куда быстрее, правда, короче не будет :)
 
Цитата
Fsociety_ написал:
не сразу но соображу) пару минут уйдет
Вот это тем более странно с учетом того, что "пару строк" не подправили самостоятельно.
По вопросам из тем форума, личку не читаю.
Страницы: Пред. 1 2
Наверх