[英]Custom VBA function using for loop & ranges
我目前正在尝试修正我自己的函数,需要一些帮助来循环遍历一组数据。 我在下面发布的代码允许我设置两个变量“CFirstCell”和“CLastCell”(这只是整个函数实际执行的一部分)。 这将返回一个地址(例如:CFirstCell:"$I$4" & CLastCell:"$AL$4")。
我现在想要获取这两个变量并遍历它们之间的单元格(在名为“客户端配置”的工作表中),然后获取那些非空白值并将它们全部存储为“AllCodes”。 一旦我将所有这些值存储在数组“AllCodes”中,我想遍历该数组并打印出包含每个值的消息。 我怎样才能做到这一点?
一个示例是循环遍历范围 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
请试试这个功能。 它应该做你需要的(我从你的话中理解)。 为了理解它是如何工作的,我创建了一个能够测试它的子:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.