вытаскивая данные из колонок в Excel

Question

У меня есть следующие данные в Excel.

CHM0123456  SRM0123:01  
CHM0123456  SRM0123:02  
CHM0123456  SRM0256:12  
CHM0123456  SRM0123:03  
CHM0123457  SRM0789:01  
CHM0123457  SRM0789:02  
CHM0123457  SRM0789:03  
CHM0123457  SRM0789:04 

Что мне нужно сделать, это вытащить все соответствующие номера SRM, которые относятся к одному номеру CHM. теперь у меня есть формула, которая будет делать что-то вроде этого

=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))

однако это немного неопрятно, и я действительно хочу создать то же самое, используя короткий скрипт vb, нужно ли мне исправлять цикл, который будет выполняться, и проверять каждую строку по очереди.

For x = 1 to 6555
if Ax = Chm123456 
string = string + Bx
else
next 

, который должен дать мне окончательную строку

SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03

использовать с тем, как я хочу.

Или это более аккуратный способ сделать это?

Приветствия

Аарон

мой текущий код

    For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value


End If


Next
MsgBox (outstring)

End Function

Answer 1

Я не уверен, каково ваше определение «аккуратного», но вот функция VBA, которую я считаю очень аккуратной, а также гибкой, и она молниеносна (10 000+ без задержек).Вы передаете ему CHM, который хотите найти, затем диапазон для поиска. Вы можете передать третий необязательный параметр, чтобы установить, как каждая запись отделяется.Таким образом, в вашем случае вы могли бы написать (при условии, что ваш список:

= ListUnique (B2, B2: B6555)

Вы также можете использовать Char (10) в качестветретий параметр для разделения на разрывы строк и т. д.

Function ListUnique(ByVal search_text As String, _
                    ByVal cell_range As range, _
                    Optional seperator As String = ", ") As String

Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

On Error Resume Next
For Each cell In cell_range
    If cell.Value = search_text Then
        dict.Add cell.Offset(, 1).Value, 1
    End If
Next

keys = dict.keys
For i = 0 To UBound(keys)
    result = result & (seperator & keys(i))
Next

If Len(result) <> 0 Then
    result = Right$(result, (Len(result) - Len(seperator)))
End If

ListUnique = result
Application.ScreenUpdating = True

End Function

Как это работает : он просто перебирает ваш диапазон в поисках строки поиска, которую вы ему даете. Если он находит, он добавляетэто к объекту словаря (который устранит все дубликаты). Вы помещаете результаты в массив, затем создаете из них строку. Технически вы можете просто передать его "B: B" в качестве поискового массива, если вы не уверены, гдеконец столбца - и эта функция будет работать нормально (1/5 секунды для сканирования каждой ячейки в столбце B с возвращением 1000 уникальных совпадений).

Answer 2

Другим решением было бы создать расширенный фильтр для Chm123456, а затем скопировать их в другой диапазон. Если вы получаете их в строковом массиве, вы можете использовать встроенную функцию Excel Join (saString, ",") (работает только со строковыми массивами).

Не актуальный код для вас, но он указывает вам возможное направление, которое может быть полезным.

ОК, это может быть довольно быстро для тонны данных. Сбор данных для каждой ячейки занимает уйму времени, лучше собрать все сразу. Уникальный для вставки, а затем получить данные, используя

vData=rUnique

где vData - это вариант, а rUnique - это скопированные ячейки. Это на самом деле может быть быстрее, чем захват каждой точки данных точка за точкой (внутреннее приложение Excel может копировать и вставлять очень быстро). Другой вариант - захватить уникальные данные, не имея копии и прошедших событий, вот как:

dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant

set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
 vdata=reach
 for i=lbound(vdata) to ubound(vdata)
  sdata=sdata & vdata(i,1)
 next l
next reach

Лично я предпочел бы вставить внутреннюю копию, чтобы вы могли просмотреть каждый лист и затем получить данные в самом конце (это было бы довольно быстро, быстрее, чем циклически проходить по каждой ячейке). Итак, просматривая каждый лист.

dim wks as worksheet

for each wks in Activeworkbook.Worksheets
 if wks.name <> "CopiedToWorksheet" then
  advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
 end if 
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
 sData=sData & ","
next i

Приведенный выше код должен быть быстрым. Я не думаю, что вы можете использовать Join для какого-либо варианта, но вы всегда можете попробовать его, это сделает его еще быстрее. Вы также можете попробовать application.worksheetfunctions.contat (или что-то еще, что называется функцией контактирования), чтобы объединить результаты, а затем просто получить окончательный результат.

On Error Resume Next
 wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents