[英]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.