求VBA代码实现if isna vlookup组合

vba789

求VBA代码实现if isna vlookup组合.rar (14.17 KB, 下载次数: 9)

2022-2-2 19:31 上传

点击文件名下载附件

ISNA屏蔽VLOOKUP错误值#N/A，如果在源数据区域找不到的话，就显示0，否则就显示查找到的值。                  
实际应用中，想用VBA代码实现if isna vlookup公式组合，不知能否实现。

taller

Find查找指定内容，如果不存在则返回NA

vba789

Sub test()
Dim arr, brr(), R As Long, i As Long, j As Integer, s As Integer, Rng As Range
Application.ScreenUpdating = False
     R = Sheet1.Range("D65536").End(xlUp).Row
      Sheet2.Range("A1:H34").ClearContents
       If R < 1 Then Exit Sub
        arr = Sheet1.Range("D1:D" & R)
        ReDim brr(1 To 8, 1 To UBound(arr))
          For i = 1 To UBound(arr)
           Set Rng = Sheet3.Range("A:A").Find(arr(i, 1))
            If Rng Is Nothing Then
        Else
            For j = 1 To 8
                brr(j, i) = Sheet3.Cells(Rng.Row, j)
            Next
           End If
         Next
    Sheet2.Range("A1").Resize(UBound(brr, 2), 8) = WorksheetFunction.Transpose(brr)
      For s = 2 To 8
       If Application.WorksheetFunction.Sum(Cells(i, s)) = 0 Then Cells(i, 1) = "" '这里是第2列至第8列求和，即如果sum（"B1:K1"）=0,则A1为空，没有达到效果
      Next
    Set Rng = Nothing
Application.ScreenUpdating = True
    MsgBox "导入"
End Sub

taller

准提部林

Sub TEST_A1()
With Range("A1:H99")
     .NumberFormatLocal = "0"
     .Formula = "=IF(COUNT(0/SUM(INDEX('1'!$B:$H,MATCH(home!$D68,'1'!$A:$A,),))),VLOOKUP(home!$D68,'1'!$A:$K,COLUMN(),),0)"
     .Value = .Value
End With
End Sub

vba789

'可能是我没表达清楚，实际报表中有很多行列，公式也能达到结果，只是内存大，所以用VBA实现if isna
vlookup组合公式
Sub test()
Dim arr, brr(), R As Long, i As Long, j As Integer,  rng As Range
Application.ScreenUpdating = False
     R = Sheet1.Range("D65536").End(xlUp).Row
      Sheet2.Range("A1:H34").ClearContents
       If R < 1 Then Exit Sub
        arr = Sheet1.Range("D68:D" & R)
        ReDim brr(1 To 8, 1 To UBound(arr))
          For i = 1 To UBound(arr)
           Set rng = Sheet3.Range("A:A").Find(arr(i, 1))
            If rng Is Nothing Then
        Else
            For j = 1 To 8
                brr(j, i) = Sheet3.Cells(rng.Row, j)
            Next
           End If
         Next
    Sheet2.Range("A1").Resize(UBound(brr, 2), 8) = WorksheetFunction.Transpose(brr)
        If Application.WorksheetFunction.Sum(Range("b1:h1")) = 0 Then Range("a1") = ""
        If Application.WorksheetFunction.Sum(Range("b2:h2")) = 0 Then Range("a2") = ""
        If Application.WorksheetFunction.Sum(Range("b3:h3")) = 0 Then Range("a3") = ""
        If Application.WorksheetFunction.Sum(Range("b4:h4")) = 0 Then Range("a4") = ""
        If Application.WorksheetFunction.Sum(Range("b5:h5")) = 0 Then Range("a5") = ""
        If Application.WorksheetFunction.Sum(Range("b6:h6")) = 0 Then Range("a6") = ""
        If Application.WorksheetFunction.Sum(Range("b7:h7")) = 0 Then Range("a7") = ""
        If Application.WorksheetFunction.Sum(Range("b8:h8")) = 0 Then Range("a8") = ""
        If Application.WorksheetFunction.Sum(Range("b9:h9")) = 0 Then Range("a9") = ""
        If Application.WorksheetFunction.Sum(Range("b10:h10")) = 0 Then Range("a10") = ""
        If Application.WorksheetFunction.Sum(Range("b11:h11")) = 0 Then Range("a11") = ""
        If Application.WorksheetFunction.Sum(Range("b12:h12")) = 0 Then Range("a12") = ""
    Set rng = Nothing
Application.ScreenUpdating = True
    MsgBox "导入"
End Sub