excel 中BVA 麻烦大佬帮忙解释一下

大龙媛 · 发表于 2022-6-6 18:03:11

Option Compare Text

Public 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

大龙媛 · 发表于 2022-6-6 18:04:26

本人是小白，想请教大佬，如何能看懂以上信息

魍者归来 · 发表于 2022-6-6 19:17:09

微软官方的bbs里是有专业的VBA教程和API端口说明能检索的（全英文）

机器画家 · 发表于 2022-6-7 08:52:01

上excel必威APP精装版下载问问看

		自动登录	找回密码
密码			注册会员