excel 中BVA 麻煩大佬幫忙解釋一下

[復制鏈接]

大龍媛

電梯直達

1^#

發表于 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