Допустим есть сгруппированная таблица, где в столбце С уникальные идентификаторы (артикулы) и нужно получить имя группировки, вот функция это и делает. Применение: =FindGroupName(ячейка_шаблон;диапазон)
Function FindGroupName(RCell As Range, RRange As Range)
Dim Pattern As String, Result As Integer
Result = 0
Pattern = RCell.Value
If RRange.Columns.Count > 1 Then
RRange = RRange.Columns(1)
End If
For Each fCell In RRange.Cells
If fCell.Value = Pattern Then
For StrResultRange = fCell.Row To 1 Step -1
If RRange.Rows(StrResultRange) = "" Then
Result = RRange.Rows(StrResultRange).Row
Exit For
End If
Next StrResultRange
If Result > 0 Then
Exit For
End If
End If
Next
If Result > 0 Then
FindGroupName = Worksheets(RRange.Parent.Name).Range("A" & Result).Value
Else
FindGroupName = ""
End If
End Function
Как то так
Это второй вариант, он несколько быстрее предыдущего, за счет отсутствия второго цикла и других оптимизаций, но все равно долгий на большом количестве строк (((
Function FindGroupName(RCell As Range, RRange As Range)
Dim Pattern As String, Result As Integer, NumEmpStr As Integer
Dim arr
Pattern = RCell.Value
strEnd = Cells(RRange.Count, 1).End(xlUp).Row
'copy to array
arr = RRange.Cells(RRange.Row, 1).Resize(strEnd).Value
For numStr = 1 To strEnd Step 1
If arr(numStr, 1) = vbNullString Then
NumEmpStr = numStr
End If
If StrComp(arr(numStr, 1), Pattern, vbTextCompare) = 0 Then
Result = NumEmpStr
Exit For
End If
Next numStr
If Result > 0 Then
FindGroupName = Worksheets(RRange.Parent.Name).Range("A" & Result).Value
Else
FindGroupName = ""
End If
End Function
Третий вариант, добавлен два параметра ТолькоАртикул (читай номер строки) и префикс, котрый прибавляется к этому артикулу. Применение: =FindGroupName(F2;All!C:C;"MI";ИСТИНА) - результат MI7
Function FindGroupName(RCell As Range, RRange As Range, Pref As String, OnlyArticle As Boolean)
Dim Pattern As String, Result As Integer, NumEmpStr As Integer, arr
Pattern = RCell.Value
strEnd = Cells(RRange.Count, 1).End(xlUp).Row
'copy to array
arr = RRange.Cells(RRange.Row, 1).Resize(strEnd).Value
For numStr = 1 To strEnd Step 1
If arr(numStr, 1) = vbNullString Then
NumEmpStr = numStr
End If
If StrComp(arr(numStr, 1), Pattern, vbTextCompare) = 0 Then
Result = NumEmpStr
Exit For
End If
Next numStr
If Result > 0 Then
If OnlyArticle Then
FindGroupName = Pref & Result
Else
FindGroupName = Worksheets(RRange.Parent.Name).Range("A" & Result).Value
End If
Else
FindGroupName = ""
End If
End Function
Комментариев нет:
Отправить комментарий