excel 中BVA 麻烦大佬帮忙解释一下
Option Compare TextPublic Function GSXS(Ref)
GSXS = Ref.Formula
End Function
Public Function ZZL(RowHead, ColHead, Dummy)
Dim Values(20) As Variant
Dim PrevData(20) As Variant
Dim LE(20) As Integer
On Error GoTo err_handler1
' Do the vertical selection from rows
If RowHead.Rows.Count = 1 Then
rindex = RowHead.Row ' first argument is any cell on the row of possible values
Else
' Store the values to be compared with each column
For ii = 1 To RowHead.Columns.Count
rngname = RowHead.Cells(1, ii)
LE(ii) = InStr(rngname, "<=")
If LE(ii) > 0 Then
rngname = Mid(rngname, 1, LE(ii) - 1)
End If
Values(ii) = Range(rngname)
'debug.Print "Variable:" & rngname & " is:" & Values(ii)
PrevData(ii) = "" ' initialise
Next ii
rindex = 2
'debug.Print RowHead.Columns.Count
Match = False
For r = rindex To RowHead.Rows.Count
For c = 1 To RowHead.Columns.Count ' for each dimension
data = RowHead.Cells(r, c)
If data = "" Then
'debug.Print "Empty cell found: using " & PrevData(c)
' use the last valid cell in this column
' (this is to handle merged cells)
data = PrevData(c)
End If
'debug.Print "data:" & data
PrevData(c) = data ' save for use by empty cells
If data = Values(c) Or (data > Values(c) And LE(c) > 0) Or data = "*" Then
If c = RowHead.Columns.Count Then ' All columns match - It's a go
Match = True
End If
Else ' This column doesn't match - go to the next row
Match = False
Exit For
End If
Next c
If Match = True Then ' Don't search any more rows
rindex = r
Exit For
End If
Next r
If Match = False Then ' Didn't find a matching set of values
ZZL = "No match for rows"
Exit Function
End If
rindex = rindex + RowHead.Row - 1 ' make absolute index
End If
' Do the horizontal selection from columns
If ColHead.Columns.Count = 1 Then
cindex = ColHead.Column
Else
' Store the values to be compared with each row of the header
For ii = 1 To ColHead.Rows.Count
rngname = ColHead.Cells(ii, 1)
LE(ii) = InStr(rngname, "<=")
If LE(ii) > 0 Then
rngname = Mid(rngname, 1, LE(ii) - 1)
End If
Values(ii) = Range(rngname)
'debug.Print "Variable:" & rngname & " is:" & Values(ii)
PrevData(ii) = "" ' initialise
Next ii
cindex = 2
'debug.Print ColHead.Columns.Count
Match = False
For c = cindex To ColHead.Columns.Count
For r = 1 To ColHead.Rows.Count ' for each dimension
data = ColHead.Cells(r, c)
If data = "" Then
'debug.Print "Empty cell found: using " & PrevData(r)
' use the last valid cell on this row
' (this is to handle merged cells)
data = PrevData(r)
End If
'debug.Print "data:" & data
PrevData(r) = data ' save for use by empty cells
If data = Values(r) Or (data > Values(r) And LE(r) > 0) Or data = "*" Then
If r = ColHead.Rows.Count Then ' All rows match - It's a go
Match = True
End If
Else ' This row doesn't match - go to the next column
Match = False
Exit For
End If
Next r
If Match = True Then ' Don't search any more columns
cindex = c
Exit For
End If
Next c
If Match = False Then ' Didn't find a matching set of values
ZZL = "No match for columns"
Exit Function
End If
cindex = cindex + ColHead.Column - 1
End If
' Return the cell value from Table
'debug.Print "Answer is in (R,C):" & rindex, cindex
ZZL = ActiveSheet.Cells(rindex, cindex)
'debug.Print "Answer is : " & ZZL
Exit Function
err_handler1:
ZZL = "Error on range '" & rngname & "'"
End Function
本人是小白,想请教大佬,如何能看懂以上信息 微软官方的bbs里是有专业的VBA教程和API端口说明能检索的(全英文) 上excel论坛问问看
页:
[1]