Пользовательская функция VBA для l oop и диапазонов

Question

В настоящее время я пытаюсь исправить свою собственную функцию и мне нужна помощь с циклическим просмотром набора данных. Код, который я разместил ниже, позволяет мне установить две переменные «CFirstCell» и «CLastCell» (это только часть того, что в действительности будет выполнять общая функция). Это вернет адрес (пример этого: CFirstCell: "$ I $ 4" и CLastCell: "$ AL $ 4").

Теперь я хочу взять эти две переменные и l oop через ячейки между ними (на листе под названием «Конфигурация клиента»), а затем принимают те значения, которые не являются пустыми, и сохраняют их все «AllCodes». После того, как все эти значения будут сохранены в массиве «AllCodes», я хочу провести l oop через этот массив и распечатать сообщение с каждым значением. Как я могу это сделать?

Примером этого может быть l oop через диапазон I4: AL4, а затем возвращение окна сообщения, в котором будут напечатаны значения в ячейках I4: P4, потому что они являются только те, которые не являются пустыми.

Public Function GETHOLDINGS(ClientId, Category, CategoryValue, DisplayValueAs) As String

    Dim ClientName As String
    Dim ReportingType As String    

    Dim CFirstCell As String
    Dim CLastCell As String

    Dim AllCodes As String

    ClientName = WorksheetFunction.Index(Sheets("Client Configuration").Range("Client_Config_Table[[#All],[Client Name]]"), _
    WorksheetFunction.Match(1, Sheets("Client Configuration").Range("Client_Config_Table[[#All],[ID]]")))

    ReportingType = WorksheetFunction.Index(Sheets("Client Configuration").Range("Client_Config_Table[[#All],[Portfolio Reporting Type]]"), _
    WorksheetFunction.Match(1, Sheets("Client Configuration").Range("Client_Config_Table[[#All],[ID]]")))

    CFirstCell = WorksheetFunction.Index(Sheets("Client Configuration").Range("Client_Config_Table[[#All],[C1]]"), _
    WorksheetFunction.Match(1, Sheets("Client Configuration").Range("Client_Config_Table[[#All],[ID]]"))).Address
    CLastCell = WorksheetFunction.Index(Sheets("Client Configuration").Range("Client_Config_Table[[#All],[C30]]"), _
    WorksheetFunction.Match(1, Sheets("Client Configuration").Range("Client_Config_Table[[#All],[ID]]"))).Address

End Function

Answer 1

Попробуйте эту функцию, пожалуйста. Он должен делать то, что (я понял из твоих слов часть) тебе нужно. Чтобы понять, как это работает, я создал сабвуфер, способный его протестировать:

Sub testGETHOLDINGS()
    Dim sh As Worksheet, rng As Range, CFirstCell As String
    Dim AllCodes As Variant, El As Variant, CLastCell As String
    CFirstCell = "$I$4" 'determine it as you whish or give more
                        'details to find a different way
    CLastCell = "$AL$4" 'determine it as you whish
    Set sh = ActiveSheet 'use here your sheet
    Set rng = sh.Range(CFirstCell & ":" & CLastCell) 'build the range
    AllCodes = GETHOLDINGS(sh, rng) 'use the function to build the
                                    'array of non empty cells value
    If AllCodes = Empty Then Exit Sub 'if rng has more then one row
    For Each El In AllCodes
        Debug.Print El 'it returns in Immediate Window all elements
    Next
End Sub

Private Function GETHOLDINGS(sh As Worksheet, rng As Range) As Variant
  Dim arrC() As String, arrRng As Variant, i As Long, lngEmpty As Long
  Dim nonEmpty As Long, k As Long, rngRow As Long

  rngRow = rng.Cells(1, 1).Row 'determine the range row
  If rng.Rows.count > 1 Then 'stops if rang has more the 1 row
    MsgBox "This function works for one single row range!"
    GETHOLDINGS = Empty: Exit Function
  End If
  'determine how many empty cells are in rng
  lngEmpty = rng.SpecialCells(xlCellTypeBlanks).Cells.count
  nonEmpty = rng.Cells.count - lngEmpty 'non empty cells number
  ReDim arrC(nonEmpty + 1) 'redim the array to the appropriate value
  arrRng = rng.Value 'pass the range values in arrRng array
  For i = 1 To rng.Cells.count 'iterate between the array elements
    If sh.Cells(rngRow, i).Value <> Empty Then
        'load in the array the non empty cells
        arrC(k) = sh.Cells(rngRow, i).Value: k = k + 1
    End If
  Next i
  If arrC(0) <> Empty Then GETHOLDINGS = arrC ' return the array
End Function