Преобразование всех элементов массива из строки в double сразу VBA. Vba массив в строку
vba - Преобразование всех элементов массива из строки в double сразу VBA
Я пытаюсь понять концептуально, как можно, на любом уровне абстракции, "что-то делать" на каждый (ключевое слово здесь каждый) в массиве без обработки по одному.
На самых низких уровнях абстракции относительно одного процессора каждый элемент в массиве всегда обрабатывается по одному за раз. ЦП не может взять коллекцию и магически преобразовать каждый элемент без итерации через каждый элемент в коллекции. Слова Итерация (и, следовательно, цикл) и каждый очень нравятся друг другу.
Теперь, возможно ли, на более высоких уровнях абстракции, представить программисту метод/функцию/процедуру, которая выглядит так, как будто она действует на всю коллекцию? Да, это очень возможно. LINQ (в .NET) делает это много. Тем не менее, все функции LINQ предоставляют возможность для программиста действовать в каждом элементе в коллекции, используя только один оператор.
Даже если у VBA был способ преобразовать элементы в массив из одного типа в другой (что я не верю, что это так), на некотором уровне абстракции программа должна будет итерации через каждый элемент в списке для выполнения изменения.
Сказав это, я думаю, вы застряли в цикле. Лучшее, что вы могли бы сделать, это обернуть эту функциональность в пределах функции. Здесь примерная функция с некоторым тестовым кодом:
Function ConvertArray(arrStr() As String) As Double() Dim strS As String Dim intL As Integer Dim intU As Integer Dim intCounter As Integer Dim intLen As Integer Dim arrDbl() As Double intL = LBound(arrStr) intU = UBound(arrStr) ReDim arrDbl(intL To intU) intCounter = intL Do While intCounter <= UBound(arrDbl) arrDbl(intCounter) = CDbl(arrStr(intCounter)) intCounter = intCounter + 1 Loop ConvertArray = arrDbl End Function Sub Test() Dim strS(0 To 2) As String Dim dblD() As Double Dim dbl As Variant strS(0) = "15.5" strS(1) = "12" strS(2) = "4.543" dblD = ConvertArray(strS) For Each dbl In dblD Debug.Print dbl Next dbl End Sub|
Ситуация: дана строка, в которой через запятую перечислены значения (или диапазоны значений) Требуется подсчитать, сколько значений содержится в строке, или же разбить строку на массив, содержащий все значения из исходной строки. И, если при исходных строках вида "5,6,8,18,2,21" всё просто (достаточно применить VB-функцию Split), то при наличии в строке диапазонов значений вида Число1-Число2 (например, строка "9-15,18,2,11-9") задача заметно усложняется. В этих случаях на помощь придёт функция ArrayOfValues Function ArrayOfValues(ByVal txt$) As Variant ' Принимает в качестве параметра строку типа ",,5,6,8,,9-15,18,2,11-9,,1,4,,21," ' Возвращает одномерный (горизонтальный) массив в формате ' array(5,6,8,9,10,11,12,13,14,15,18,2,11,10,9,1,4,21) ' (пустые значения удаляются; диапазоны типа 9-15 и 17-13 раскрываются) arr = Split(Replace(txt$, " ", ""), ","): Dim n As Long: ReDim tmpArr(0 To 0) For i = LBound(arr) To UBound(arr) Select Case True Case arr(i) = "", Val(arr(i)) < 0 ' раскомментируйте эту строку, чтобы пустые и нулевые значения ' тоже добавлялись в результат (преобразовывались в значение -1) 'tmpArr(UBound(tmpArr)) = -1: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Case IsNumeric(arr(i)) tmpArr(UBound(tmpArr)) = arr(i): ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Case arr(i) Like "*#-#*" spl = Split(arr(i), "-") If UBound(spl) = 1 Then If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1) tmpArr(UBound(tmpArr)) = j: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1) Next j End If End If End Select Next i On Error Resume Next: ReDim Preserve tmpArr(0 To UBound(tmpArr) - 1) ArrayOfValues = tmpArr End FunctionИспользовать её можно так: Sub ПримерИспользования() ' разбиваем строку в массив, содержащий все значения исходной строки a = ArrayOfValues(",,5,6,8,,9-15,18,2,11-9,,1,4,,21,") Debug.Print Join(a, ",") ' объединяем обратно созданный массив ' результатом будет строка "5,6,8,9,10,11,12,13,14,15,18,2,11,10,9,1,4,21" End SubФункция нашла применение в программе выгрузки тарифов в XML
Ещё один вариант функции, только она возвращает из аналогичной текстовой строки КОЛЛЕКЦИЮ НЕПОВТОРЯЮЩИХСЯ чисел от 1 до 255
Не получается применить макрос? Не удаётся изменить код под свои нужды? Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать. |
excelvba.ru
arrays - Сравнение двух массивов в VBA и добавление строк
так как я довольно новичок в VBA Мне нужна помощь с частью моего кода, которая должна сравнивать два массива, отсортированные по возрастанию, и если значение в любом из массивов отсутствует, то оно должно добавить строку в соответствующую таблицу и заполнить отсутствующее значение нулевым значением в ячейке рядом с ней. Это то, что у меня есть до сих пор:
With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row End With For I = 3 To LastRow If Cells(I, 1) > Cells(I, 6) Then LastRow = LastRow + 1 With Range("A" & I & ":C" & I) .Select .Insert Shift:=xlDown End With Range("A" & I) = Cells(I, 6) Cells(I, 2).Value = 0 ElseIf Cells(I, 1).Value < Cells(I, 6).Value Then With Range("F" & I & ":H" & I) .Select .Insert Shift:=xlDown End With Range("F" & I) = Cells(I, 1) Cells(I, 7).Value = 0 Else End If Next iЯ знаю, что решение, вероятно, связано с определением обоих массивов и использованием LBound для Ubound, но я не мог обвести его вокруг. Большое спасибо за помощь!
EDIT: Последняя строка, кажется, теперь исправлена, однако я все еще не могу каким-то образом пропускать пустые ячейки и ячейку в последней, которая содержит текст "Grand Total" внутри и, следовательно, не сортируется в отличие от остальной части диапазона. У кого-нибудь есть идеи, как обойти это? Вот как выглядит код:
ИЗМЕНИТЬ 2: Я понял это наконец! Я добавил еще одно условие, чтобы добавить строку в противоположную таблицу, если она найдет значение "Grand Total". Не нужно беспокоиться о пустых ячейках!
Является ли строка массивом в VBA, с которой можно выполнить итерацию? MS Excel онлайн
Например, могу ли я перебирать его, как я мог, в C / C ++?
Каким будет эквивалент в VBA? Он не ведет себя так, как я ожидал. Никогда в действительности не пытались манипулировать многими строками раньше в VBA! 🙂
Это не массив, но то, что вы хотите, можно сделать с помощью MID
Sub test() Dim strSentence As String Dim lngCount As Long strSentence = "This is a string" For lngCount = 1 To Len(strSentence) Debug.Print Mid(strSentence, lngCount, 1) Next lngCount End SubСм. Также ответ Матта Матса для дополнительной хорошей точки.
редактировать
На самом деле есть второй способ итерации по строке, которая заключается в преобразовании строки в массив одноразрядных строк, а затем итерации через них. Для этого нам нужно преобразовать исходную строку в формат unicode, чтобы символ Null можно было использовать как разделитель. Вот воспроизводимый пример:
Из любопытства я сравнил два подхода (используя версию Мата Mid, которая быстрее):
Sub test_sub() Dim strTest(1 To 5000) As String Dim lngStringIter As Long Dim lngChars As Long, dblTick As Double ' Generate some long strings first For lngStringIter = 1 To 5000 strTest(lngStringIter) = vbNullChar For lngChars = 1 To 10 strTest(lngStringIter) = strTest(lngStringIter) & _ Chr(Int((90 - 65 + 1) * Rnd + 65)) & strTest(lngStringIter) Next lngChars Next lngStringIter ' Lets see what happens.. dblTick = CDbl(Now()) For lngStringIter = 1 To 5000 test strTest(lngStringIter) Next lngStringIter Debug.Print "Time Mid: ", CDbl(Now()) - dblTick dblTick = CDbl(Now()) For lngStringIter = 1 To 5000 test2 strTest(lngStringIter) Next lngStringIter Debug.Print "Time Split: ", CDbl(Now()) - dblTick End SubРезультаты:
Time Mid: 4.62962998426519e-05 Time Split: 1.15740767796524e-05Строка VBA реализуется как тип данных BSTR . Более подробную информацию об этом типе данных можно найти здесь и здесь .
Строка представляет собой массив байтов, и вы можете перебирать ее, если знаете свой путь вокруг двухбайтовых реализаций строки (или 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 = 84h Байт 2 = 104e Байт 4 = 101Байт 6 = 32q Байт 8 = 113u Байт 10 = 117i Байт 12 = 105c Байт 14 = 99k Байт 16 = 107Байт 18 = 32B Байт 20 = 66r Байт 22 = 114o Байт 24 = 111w Байт 26 = 119n Байт 28 = 110Байт 30 = 32F Байт 32 = 70o Байт 34 = 111x Байт 36 = 120
?! * быстрый Браун Фокс
Обратите внимание на «Шаг 2» в цикле: я отбрасываю каждый другой байт, потому что знаю, что это простые ванильные латинские буквы – текст «ASCII» для непосвященных.
Это становится интересным, когда вам приходится иметь дело с текстом на арабском и пиньинь: и вы никогда не должны предполагать на листе реального мира, что вы всегда будете иметь дело с простым ванильным US ASCII, как я это делал в этой демонстрационной части.
Для более полного примера, с более подробным объяснением, попробуйте это у Excellerando:
Запись диапазона Excel в файл csv: оптимизация и совместимость с Unicode
Оптимизация байтового массива находится в нижней части под этой рубрикой:
Реализация VBA контрольной суммы Adler-32, работающей на байт-массивах вместо использования строковой обработки VBA.
Основной характер строки, похоже, не так широко известен, как должен: это не то, что вы часто будете использовать в своем коде, но много проблем с Unicode и нелатинскими алфавитами, которые люди получают проще, когда они имеют более глубокое понимание переменных в своем коде.
Mid работает, чтобы получить n- й символ в любой строке, но возвращает Variant , что приводит к неявному преобразованию в String .
Используйте «строго типизированную» версию: Mid$ вместо этого.
Я не думаю, что VBA позволяет обрабатывать строку как массив без преобразования.
Однако вы можете использовать MID для получения одного символа за раз.
Код OTTOMH
declare i as integer declare strlen as int strlen = Len (YourIncomingString) for i = 0 to strlen print Mid (YourIncomingString, i, 1)Простой ответ: нет, строка не является объектом в VBA. Вы должны были бы разобрать его на персонаже в то время, используя функции mid и len.
По-прежнему можно создать собственную пользовательскую перечислимую строку.
Перечислимую строку можно использовать следующим образом:
Dim es As EnumerableString Set es = New EnumerableString es.Value = ActiveCell.Value Dim ch As Variant For Each ch In es ActiveCell.Offset(1, 0).Activate ActiveCell.Value = ch Next chСохраните этот код в файле с именем EnumerableString.cls и импортируйте его в VBA Project.
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "EnumerableString" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private m_characters As Collection Public Property Get NewEnum() As IUnknown Attribute NewEnum.VB_UserMemId = -4 Attribute NewEnum.VB_MemberFlags = "40" Set NewEnum = m_characters.[_NewEnum] End Property Public Property Let Value(ByVal newValue As String) Dim pos As Integer Set m_characters = New Collection For pos = 1 To Len(newValue) m_characters.Add Mid$(newValue, pos, 1) Next pos End Property Public Function Length() As Long Length = m_characters.Count End Function Public Function Item(ByVal index As Variant) As String Attribute Item.VB_UserMemId = 0 Item = m_characters(index) End Function Private Sub Class_Initialize() Set m_characters = New Collection End SubРезультат в Excel, пример с символами ASCII, ANSI и Unicode UTF-8:
excel.bilee.com
Преобразование массива строки в новую строку в VBA MS Excel онлайн
Если вы не хотите вводить сложный мир регулярных выражений,
- сделать это в 2 этапа с использованием промежуточной замены
- Следуйте правилу размещения первых строк в исходном массиве. Следовательно, Power Partner OEM должен прийти перед Power Partner .
,
Private Function cvrt(orig As Variant) As Variant Dim i As Long, orgVal, newVal, interm cvrt = orig orgVal = Array("Power Partner OEM", "Power Partner", "Central", "Clarke") interm = Array("xxx0", "xxx1", "xxx2", "xxx3") newVal = Array("Onsite Energy OEM", "Onsite Power Partner", "Central Data", "Clarke Data") For i = 0 To 3 cvrt = Replace(cvrt, orgVal(i), interm(i), vbTextCompare) Next i For i = 0 To 3 cvrt = Replace(cvrt, interm(i), newVal(i), vbTextCompare) Next i End FunctionОбратите внимание, что промежуточный массив не нужен, вы можете использовать "xxx" & i всюду, а не interm(i) …
У меня проблема с двумя последними строками в моем коде, поскольку они почти идентичны. Когда я выполняю код, результат для «Power Partner OEM» неверен, он стал «Onsite Energy Energy OEM» – кулапо
ценность orig исходила из диапазона, который технически указан в orgVal – kulapo
Самый простой способ сделать это – не использовать Variants и использовать Range а затем использовать встроенный Range.replace с xlWhole чтобы избежать ложноположительных совпадений.
Private Function cvrt(orig As Range) As Range '<~~~~~ Dim orgVal As Variant, newVal As Variant, i As Integer Dim rng As Range Set rng = orig orgVal = Array("Central", "Clarke", "Power Partner", "Power Partner OEM") newVal = Array("Central Data", "Clarke Data", "Onsite Power Partner", "Onsite Energy OEM") For i = 0 To 3 rng.Replace What:=orgVal(i), Replacement:=newVal(i), LookAt:=xlWhole Next i Set orig = rng End FunctionСкриншот
Sub Sample() Dim r As Range Set r = cvrt(Range("A1:A4")) End Sub Private Function cvrt(orig As Range) As Range Dim orgVal As Variant, newVal As Variant, i As Integer Dim rng As Range Set rng = orig orgVal = Array("Central", "Clarke", "Power Partner", "Power Partner OEM") newVal = Array("Central Data", "Clarke Data", "Onsite Power Partner", "Onsite Energy OEM") For i = 0 To 3 rng.Replace What:=orgVal(i), Replacement:=newVal(i), LookAt:=xlWhole Next i Set orig = rng End Function
excel.bilee.com
arrays - VBA Store 1 D массив в новую строку, только если уникальный
Тим Уильямс прав о тех функциях Trim.
Я предлагаю второй ответ, потому что похоже, что вы можете искать совпадение всех элементов массива в любом порядке и что некоторые элементы массива пусты или нулевые строки (которые не должны учитываться?).
Вы также должны избегать свойства .Text поскольку на нем будет отображаться только то, что видно в ячейке листа. Таким образом, #### может быть возможным значением, например.
Конечным моментом является то, что если ваш лист Excel большой и вы тестируете множество массивов, то каждый раз чтение значений с этого листа занимает довольно много времени. Вы могли бы лучше читать их в какой-то объект хранения данных и проверять наличие ваших ценностей против этого. Вы увидите, что я использовал Collection.
В общем, ваш код может быть таким... Сначала создайте Sub в вашем модуле, который считывает данные в переменную уровня модуля:
Option Explicit Private mSheetData As Collection Private Sub ReadExcelData() Dim sheetArr As Variant Dim lineData As Collection Dim r As Long, c As Long 'Read the Excel sheet into a collection - you could be more sophisticated than UsedRange sheetArr = ThisWorkbook.Worksheets("word List").UsedRange.Value2 Set mSheetData = New Collection For r = 1 To UBound(sheetArr, 1) Set lineData = New Collection For c = 1 To UBound(sheetArr, 2) If Not IsEmpty(sheetArr(r, c)) Then On Error Resume Next 'avoids error if it a duplicate in the line lineData.Add True, Trim(CStr(sheetArr(r, c))) On Error GoTo 0 End If Next If lineData.Count > 0 Then mSheetData.Add lineData Next End SubЗатем добавьте функцию, которая проверяет наличие ваших образцов массивов:
Private Function HasMatch(inputArr() As Variant) As Boolean Dim c As Long Dim lineData As Collection For Each lineData In mSheetData For c = LBound(inputArr) To UBound(inputArr) If Not IsEmpty(inputArr(c)) Then If Len(inputArr(c)) > 0 Then HasMatch = False On Error Resume Next HasMatch = lineData(Trim(CStr(inputArr(c)))) On Error GoTo 0 If Not HasMatch Then Exit For End If End If Next If HasMatch Then Exit Function Next End FunctionТогда у вас просто есть процедура вызова, например:
Public Sub RunMe() Dim rng As Range Dim sample() As Variant 'Read the data into the array ReadExcelData 'Acquire the next blank line With ThisWorkbook.Worksheets("word List") Set rng = .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With 'Test your line(s) sample = Array("Dog", "Cat", "6", "Some string like this") If Not HasMatch(sample) Then rng.Resize(, UBound(sample) - LBound(sample) + 1).Value = sample Set rng = rng.Offset(1) 'offset the next blank line ready for next input End If End Subqaru.site
[vba] Как искать строку в массиве [arrays]
Если вы хотите узнать, найдена ли строка в массиве вообще, попробуйте эту функцию:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End FunctionКак указывает Шон Чешир , это должен быть одномерный массив.
Пример:
Sub Test() Dim arr As Variant arr = Split("abc,def,ghi,jkl", ",") Debug.Print IsInArray("ghi", arr) End Sub(Ниже код обновлен на основе комментария от HansUp )
Если вам нужен индекс соответствующего элемента в массиве, попробуйте следующее:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long Dim i As Long ' default return value if value not found in array IsInArray = -1 For i = LBound(arr) To UBound(arr) If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then IsInArray = i Exit For End If Next i End FunctionЭто также предполагает 1-мерный массив. Имейте в виду, что LBound и UBound основаны на нуле, поэтому индекс 2 означает третий элемент, а не второй.
Пример:
Sub Test() Dim arr As Variant arr = Split("abc,def,ghi,jkl", ",") Debug.Print (IsInArray("ghi", arr) > -1) End SubЕсли у вас есть конкретный пример, обновите свой вопрос, иначе примерный код может не применяться к вашей ситуации.
Другой вариант, который обеспечивает точное сопоставление (то есть без частичного совпадения), будет:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0)) End FunctionВы можете больше узнать о методе Match и его аргументах по http://msdn.microsoft.com/en-us/library/office/ff835873(v=office.15).aspx
есть функция, которая вернет массив всех найденных строк.
Filter(sourcesrray, match[, include[, compare]]) Источник должен быть 1 размерным Функция вернет все строки в массиве, в которых есть строка соответствия
code-examples.net
