Сравнить строку с массивом строк и вывести наиболее полные совпадения - Visual Basic .NET. Массив строк vba
Добавить строки в динамический массив VBA MS Excel онлайн
Вот одно решение. Я сломал вашу функцию соответствия и заменил ее функцией Find .
Option Explicit Sub AddToArray() Dim primaryColumn As Range, secondaryColumn As Range, matchedRange As Range Dim i As Long, currentIndex As Long Dim matchingNames As Variant With ThisWorkbook.Worksheets("Sheet1") Set primaryColumn = .Range("A1:A10") Set secondaryColumn = .Range("B1:B10") End With 'Size your array so no dynamic resizing is necessary ReDim matchingNames(1 To primaryColumn.Rows.Count) currentIndex = 1 'loop through your primary column 'add any values that match to the matchingNames array For i = 1 To primaryColumn.Rows.Count On Error Resume Next Set matchedRange = secondaryColumn.Find(primaryColumn.Cells(i, 1).Value) On Error GoTo 0 If Not matchedRange Is Nothing Then matchingNames(currentIndex) = matchedRange.Value currentIndex = currentIndex + 1 End If Next i 'remove unused part of array ReDim Preserve matchingNames(1 To currentIndex - 1) 'matchingNames array now contains just the values you want... use it how you need! Debug.Print matchingNames(1) Debug.Print matchingNames(2) '...etc End SubНет необходимости создавать свою собственную функцию Match, потому что она уже существует в VBA:
Application.Match() WorksheetFunction.Match()и, как я уже упоминал выше, вы также можете добиться того же результата с помощью функции Find которая здесь является моим предпочтением, потому что я предпочитаю, чтобы вы не могли проверить отсутствие совпадений (другие методы бросают менее удобные ошибки).
Наконец, я также решил перестроить ваш код на один Sub а не на две Functions . Вы ничего не возвращали с AddToArray функции AddToArray которая в значительной степени означает по определению, что она фактически должна быть Sub
Как я уже сказал в комментарии к вопросу, в вашем коде есть несколько проблем, прежде чем добавлять что-либо к массиву, что помешает этому работать, но если предположить, что это было вызвано упрощением кода, чтобы задать вопрос, Работа.
Конкретный вопрос, который вы задаете, заключается в том, как заполнить массив, увеличивая его размер, когда это необходимо.
Для этого просто выполните следующее:
Вместо:
ReDim Preserve a(size) For Each rw In sh.Rows If Match(sh.Cells(rw.Row, 1), s, column) = True ThenИзмените порядок, чтобы он:
For Each rw In sh.Rows If Match(sh.Cells(rw.Row, 1), s, column) = True Then ReDim Preserve a(size) 'increase size of array a(size) = sh.Cells(rw.Row,1) 'put value in array size = size + 1 'create value for size of next array End If Next rw ....Вероятно, это не лучший способ выполнить эту задачу, но это то, о чем вы просили. Во-первых, увеличение размера массива КАЖДОЕ время будет тратить много времени. Было бы лучше увеличить размер массива каждые 10 или 100 совпадений, а не каждый раз. Я оставлю это упражнение вам. Затем вы можете изменить размер в конце до нужного размера.
excel.bilee.com
arrays - Является ли строка массивом в VBA, с которой можно выполнить итерацию?
Строка - это массив байтов, и вы можете перебирать ее, если знаете свой путь вокруг двухбайтовых реализаций строки (или Unicode, который обычно составляет 2 байта на символ, но может быть больше: и всегда будет 2 байта, если ваша строка возникла в VBA).
Когда я говорю , я имею в виду: нет необходимости в преобразовании типа, и это будет работать нормально:
Public Sub TestByteString() Dim strChars As String Dim arrBytes() As Byte Dim i As Integer strChars = "The quick Brown Fox" arrBytes = strChars Debug.Print strChars Debug.Print For i = LBound(arrBytes) To UBound(arrBytes) Step 2 Debug.Print Chr(arrBytes(i)) & vbTab & "Byte " & i & " = " & arrBytes(i) Next i arrBytes(0) = Asc("?") arrBytes(2) = Asc("!") arrBytes(4) = Asc("*") strChars = arrBytes Debug.Print Debug.Print strChars Erase arrBytes End SubВаши выходы будут выглядеть так:
Быстрая Браун ФоксT Байт 0 = 84 h Байт 2 = 104 e Байт 4 = 101 Байт 6 = 32 q Байт 8 = 113 u Байт 10 = 117 i Байт 12 = 105 c Байт 14 = 99 k Байт 16 = 107 Байт 18 = 32 B Байт 20 = 66 r Байт 22 = 114 o Байт 24 = 111 w Байт 26 = 119 n Байт 28 = 110 Байт 30 = 32 F Байт 32 = 70 o Байт 34 = 111 x Байт 36 = 120
?! * quick Brown Fox
Обратите внимание на "Шаг 2" в цикле: я отбрасываю каждый другой байт, потому что знаю, что это простые ванильные латинские символы - текст "ASCII" для непосвященных.
Интересно, когда вам приходится иметь дело с текстом на арабском и пиньинь: и вы никогда не должны предполагать на листе реального мира, что вы всегда будете иметь дело с простым американским ASCII, как я это делал в этой демонстрации шт.
Для более подробного примера, с более подробным объяснением, попробуйте это у Excellerando:
Написание диапазона Excel для файл csv: оптимизация и совместимость с unicode
Оптимизация байтового массива находится в нижней части под этим заголовком:
Реализация VBA контрольной суммы Adler-32, работающая на байтовых массивах вместо использования обработки строк VBA.
Основной характер строки не так широко известен, как должен быть: это не то, что вы часто будете использовать в своем коде, но много проблем с Unicode и нелатинскими алфавитами, которые людям становится легче, когда они имеют более глубокое понимание переменных в своем коде.
qaru.site
arrays - Как создать и передать массив строк в sub в Excel VBA?
Массивы VBA новы для меня, и кажется, что существует несколько способов создания массивов строк.
- Мне кажется, мне нужно создать динамический массив
- Но я не могу найти примеров, как передать динамические массивы в подпрограмму
Я знаю, сколько элементов должно быть в массиве по счету диапазона Пользователя (так, может быть, мне не нужен динамический массив?). У меня возникли проблемы с передачей массива в другую подпрограмму.
Мыслительный процесс выглядит следующим образом:
- Итерации через список имен пользователей
- Создайте лист для каждого
- Сохраните каждое имя пользователя в массиве, когда я повторяю
- В другой подпрограмме выберите все созданные мной листы и сохраните их как PDF
Ниже мой код. Я получаю ошибку времени выполнения 9 - индекс вне диапазона (ссылается на объект массива)
Я ценю любую помощь! Спасибо!
Sub CreateAllDashboards(StartDate As Date, EndDate As Date) 'Used to iterate through the list of users and call the Sub to create Dashboards Dim UserNameRangeStart As Range Set UserNameRangeStart = Range("UserName") Dim SheetNames() As String 'Cyle through users For i = 1 To GetUserNameRange().CounT 'Some code ReDim Preserve SheetNames(i) SheetNames(i) = UserNameRangeStart.Offset(i, 0).Value Next i Call CreatePDF(EndDate, SheetNames) 'Also tried SheetNames() End Sub Sub CreatePDF(FileDate As Date, ByRef SheetNames As Variant) Dim FilePath As String, FileName As String FilePath = Application.ActiveWorkbook.Path FileName = "Production Dashboards - " & Format(FileDate, "mmddyy") & ".pdf" ThisWorkbook.Sheets(SheetNames).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=True End Sub источник поделитьсяstring - vba Excel 2010: преобразовать массив строк в массив int
Цитирование через массив и преобразование значений один за другим достаточно быстро. Здесь приведен фрагмент кода, показывающий, насколько быстро цикл преобразования связан с выполнением ввода/вывода ячеек:
Private Const I_MAX = 10000 Private Const J_MAX = 200 Private Declare Function GetTickCount Lib "kernel32.dll" () As Long Sub ticktest() Dim ticks As Long, i As Long, j As Long Dim v() As Variant Dim a() As Long 'VBA integers are internally stored as longs Dim r As Range Set r = [A1].Resize(I_MAX, J_MAX) ReDim a(1 To I_MAX, 1 To J_MAX) ticks = GetTickCount v = r Debug.Print "Read from range: " & GetTickCount - ticks Debug.Print "Type of values in v(): " & TypeName(v(1, 1)) ticks = GetTickCount For i = 1 To I_MAX For j = 1 To J_MAX a(i, j) = v(i, j) Next j Next i Debug.Print "Copy with cast to Long: " & GetTickCount - ticks ticks = GetTickCount For i = 1 To I_MAX For j = 1 To J_MAX v(i, j) = CLng(v(i, j)) Next j Next i Debug.Print "In-place cast to Variant/Long: " & GetTickCount - ticks ticks = GetTickCount r = a Debug.Print "Write from long array: " & GetTickCount - ticks ticks = GetTickCount r = v Debug.Print "Write from variant array: " & GetTickCount - ticks For i = 1 To I_MAX For j = 1 To J_MAX v(i, j) = CStr(v(i, j)) Next j Next i r = v End SubПоэтому нет никакой реальной необходимости избегать циклов с одной оговоркой: если вы выполняете ввод/вывод соты в цикле, производительность становится ужасной. Здесь, например, цикл r(i, j) = v(i, j) занимает полные 100 секунд (это 100 000 тиков или 2 000x времени цикла преобразования) для завершения.
qaru.site
Практическое руководство. Поиск строки в массиве строк (Visual Basic)
Рекомендуем использовать Visual Studio 2017
Эта документация перемещена в архив и не поддерживается.
В данном примере выполняется цикл по каждой строке в массиве строк, чтобы определить, какие из них содержат указанную подстроку. Для каждого сопоставления в примере отображается индекс подстроки в строке.
В приведенном ниже примере используются методы Contains и IndexOf объекта String.
Метод Contains указывает, содержит ли строка указанную подстроку.
Метод IndexOf сообщает расположение первого символа первого вхождения подстроки. Индекс начинается с нуля; это означает, что номер первого знака строки равен нулю. Если метод IndexOf не находит подстроку, то возвращает значение "-1".
Dim StrArray() As String = {"ABCDEFG", "HIJKLMNOP"} Dim FindThisString As String = "JKL" For Each Str As String In StrArray If Str.Contains(FindThisString) Then MsgBox("Found " & FindThisString & " at index " & Str.IndexOf(FindThisString)) End If NextДанный пример кода доступен также в качестве фрагмента кода IntelliSense. При выборе фрагмента кода он находится в разделе Типы данных, определенные Visual Basic. Дополнительные сведения см. в разделе Практическое руководство. Вставка фрагментов кода IntelliSense.
Для этого примера необходимо следующее:
В методе IndexOf учитывается регистр и используется текущий язык и региональные параметры.
В целях оптимального управления ошибками можно заключить строку поиска в блок Try конструкции Оператор Try... Catch... Finally (Visual Basic).
Задачи
Ссылки
Другие ресурсы
msdn.microsoft.com
Решение: Сравнить строку с массивом строк и вывести наиболее полные совпадения
Доброго времени! Задачку решил на своем уровне знания, но код получился ППЦ тяжелый, некрасивый, и жрущий память. Помогите переделать/оптимизировать. Вводные данные: Есть строка, состоящая из нескольких слов (от 1 до 10). Есть массив из подобных строк. Есть слова-исключения. Задача: Сравнить исходную строку с каждой из массива, выбрать те, в которой совпадает максимальное количество слов, не учитывая слова-исключения. Мой код (постарался максимально откомментировать):Imports System.Text.RegularExpressions Module String_select Public one_str As String = "Вася ел бутерброд с маслом" ' строка для поиска Public other_strings = { "Петя ел кашу с маслом", "Вася кашу с маслом тоже ел", "Петя бутерброд с икрой уронил", "Вася бутерброд с маслом уронил", "Петя ел бутерброд с маслом"} 'массив строк в которых искать совпадения Public iskl_word As String() = {"Вася", "Петя"} 'слова не участвующие в поиске, слова-исключения Public str1 As String = "не найдено" Sub Main() Dim k_mn As Integer 'коэффициент множественного совпадения (если результат не одна строка, а несколько) Dim k_t(0) As Integer ' массив номеров строк при множественном совпадении Dim ResultStr As String = "" 'вывод результата при множественном совпадении Dim k As Integer Dim s As Integer Dim s1 As Integer = 0 Dim rg As Regex = New Regex("([А-Яа-я-]+)") 'любое слово Dim rg_m As MatchCollection = rg.Matches(one_str) 'Коллекция из СОВПАДЕНИЙ отдельных слов в исходной строке Dim n As Integer = rg_m.Count 'количество отдельных слов в one_str Dim rg_new(n) As Regex ' коллекция из ОТДЕЛЬНЫХ СЛОВ в исходной строке (для сравнения) Dim rg_fin As Match For index = 0 To other_strings.GetUpperBound(0) ' от 0 до количества строк в массиве, цикл по каждой отдельной строке из other_string For index1 = 0 To n - 1 ' от 0 до размера коллекции слов -1 , цикл по каждому отдельному слову в исходной строке str1 = rg_m.Item(index1).Value rg_new(index1) = New Regex(str1) ' заполняем коллекцию из отдельных слов If Array.FindIndex(iskl_word, AddressOf check_element) < 0 Then 'проверяем на слова-исключения rg_fin = rg_new(index1).Match(other_strings(index)) ' параллельно ищем совпадения по каждому слову из one_str в строке из other_string If rg_fin.Success = True Then 'если есть совпадение s = s + 1 'накручиваем счетчик совпадений End If End If Next If s > s1 Then ' если количество совпадений в данной строке больше максимального в предыдущих k_mn = 0 'обнуляем множественное совпадение s1 = s ' максимальное количество совпадений равно текущему k = index ' номер строки с максимальным совпадением k_t.SetValue(k, 0) ' делаем массив 1х1 (0 - индекс) ReDim Preserve k_t(0) ElseIf s = s1 Then ' если одинаковое количество совпадений k_mn = 1 ' задействуем коэффициент множественного совпадения ReDim Preserve k_t(k_t.Length) ' увеличиваем длину массива с номерами строк совпадений k_t.SetValue(index, k_t.GetUpperBound(0)) End If s = 0 Next If k_mn = 0 Then 'если одна строка имеет максимальное совпадение ResultStr = other_strings(k) Else 'если несколько строк имеют максимальное совпадение For j = 0 To k_t.GetUpperBound(0) ResultStr = ResultStr & other_strings(k_t(j)) & vbCrLf Next End If MsgBox(ResultStr) End Sub Private Function check_element(ByVal str As String) As Boolean Dim result As Boolean = False If str.Equals(str1) Then result = True Return result End Function End Module[excel-vba] Можно ли заполнить массив номерами строк, которые соответствуют определенным критериям без цикла?
Тем не менее, примерно в 2-3 раза больше времени эффективного массива вариантов от Криса, но техника является мощной и имеет приложение, выходящее за рамки этого вопроса
Следует отметить, что Application.Transpose ограничен 65536 ячейками, поэтому более длинный диапазон должен быть «разбит» на куски.
Sub GetEm() Dim x x = Filter(Application.Transpose(Application.Evaluate("=IF(A1:A50000=""aa"",ROW(A1:a50000),""x"")")), "x", False) End SubВ заголовке вопроса есть предположение: медленное решение петли и медленное решение без цикла. Итак, я проверил некоторые сравнения, чтобы проверить это.
Прецедент
Я создал несколько выборочных данных, состоящих из 50 000 образцов и 50% совпадающих значений. Для самых быстрых методов я создал еще два набора образцов, снова с 50 000 строк и один с 10% совпадающими строками, другой с 90% совпадающей строкой.
Я запускал каждый из размещенных методов по этим данным в цикле, повторяя логику 10 раз (так что раз для обработки всего 500 000 строк).
50% 10% 90% ExactaBox 1300 1240 1350 ms Scott Holtzman 415000 John Bustos 12500 Chris neilsen 310 310 310 Brettdj 970 970 970 OP 1530 1320 1700Таким образом, мораль ясна: только потому, что она включает цикл, она не замедляет работу. Медленным является доступ к рабочему листу, поэтому вы должны приложить все усилия, чтобы свести к минимуму это.
Обновление Добавлен тест комментария Бреттджа: одна строка кода
Для полноты, вот мое решение
Sub GetRows() Dim valMatch As String Dim rData As Range Dim a() As Long, z As Variant Dim x As Long, i As Long Dim sCompare As String Set rData = Range("A1:A50000") z = rData ReDim a(1 To UBound(z, 1)) x = 1 sCompare = "aa" For i = 1 To UBound(z) If z(i, 1) = sCompare Then a(x) = i: x = x + 1 Next ReDim Preserve a(1 To x - 1) End SubВозможно, вам стоит взглянуть на Find vs Match vs Variant Array, который заключает, что подход к варианту массива является самым быстрым, если плотность попадания очень низкая.
Но самый быстрый метод для всех - только для отсортированных данных и точного соответствия: используйте бинарный поиск, чтобы найти fisrt и последние ocurrences, а затем получите этот подмножество данных в вариантный массив.
В этом примере ваш диапазон жестко закодирован. У вас есть запасная колонна справа? Если это так, вы можете заполнить ячейки вправо с помощью 0, если это не совпадение, или номер строки, если это так. Затем потяните это в массив и отфильтруйте. Нет циклов:
Sub NoLoop() Dim valMatch As String Dim rData As Excel.Range, rFormula As Excel.Range Dim a As Variant, z As Variant Set rData = ThisWorkbook.Worksheets(1).Range("A1:A11") 'hard-coded in original example Set rFormula = ThisWorkbook.Worksheets(1).Range("B1:B11") ' I'm assuming this range is currently empty valMatch = "aa" 'hard-coded in original example 'if it's a valid match, the cell will state its row number, otherwise 0 rFormula.FormulaR1C1 = "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)" a = Application.Transpose(rFormula.Value) z = Filter(a, 0, False) 'filters out the zeroes, you're left with an array of valid row numbers End SubЯ должен кредитовать Jon49 в Одномерном массиве из диапазона Excel для Application.Transpose трюк, чтобы получить 1-й массив.
code-examples.net
