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

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

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精装版下载问问看
页: [1]
查看完整版本: excel 中BVA 麻烦大佬帮忙解释一下