请大神帮我写个公式，谢谢

pjypl1688888

请大神帮我写个公式，麻烦发个压缩包，谢谢

jerrike

1. =VLOOKUP(B4,Sheet1!$A:$B,2,)

复制代码

pjypl1688888

jerrike 发表于 2024-9-7 09:12

你好，我是想要写一个公式就可以了，其它的向右和向下拉，要一次性将成百个上千个型号所对应的系列查找出来放在对应固定的单元格内，

你是那块小饼干

XLOOKUP,VLOOKUP就可以

jerrike

pjypl1688888 发表于 2024-9-7 10:29
你好，我是想要写一个公式就可以了，其它的向右和向下拉，要一次性将成百个上千个型号所对应的系列查找出 ...

你要求的黄色公式区又不是连续的，咋拖。 上面的公式单个复制粘贴就行了。

quqiyuan

数据这么多，用vba啊，供你参考。。。
结果还给你标识了一下，不要标识，速度还可以快点。

quqiyuan

代码如下。。。
Sub test()
    Dim rng As Range
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("表一")
    Set ws = wb.Sheets("sheet1")
    r = sht.Cells(Rows.Count, 1).End(3).Row
'_______________________________________________________________________________________

'    For i = r To 2 Step -1 '此代码为了删除多余的合并单元格(有些后面有合并行，有些后面又没有)，否则step不能准确对准行号，用完，可以注释掉
'        If sht.Cells(i, 1).MergeCells Then
'            x = sht.Cells(i, 1).MergeArea.Address
'            If (InStr(x, "$A$") > 0) And (InStr(x, "$L$") > 0) Then
'                If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i))
'            End If
'        End If
'    Next
'    rng.Delete
'_________________________________________________________________________________________

    arr = ws.[a1].CurrentRegion
    brr = sht.Range("a1:l" & sht.Cells(Rows.Count, 1).End(3).Row)
    For i = 4 To UBound(brr) Step 5
        For j = 2 To UBound(brr, 2) Step 4
            If brr(i, j) <> Empty Then
                sht.Cells(i, j).Interior.ColorIndex = 3
                brr(i + 2, j) = Application.VLookup(brr(i, j), arr, 2, 0)
                sht.Cells(i + 2, j).Interior.ColorIndex = 6
            End If
        Next
    Next
    sht.Range("a1:l" & sht.Cells(Rows.Count, 1).End(3).Row) = brr
    Beep
End Sub

quqiyuan

不要删除也可以，使用字典，供参考。。。

quqiyuan

代码如下。。。
Sub test1()         '不删除合并行方法
    Dim rng As Range
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("表一  (1)")
    Set ws = wb.Sheets("sheet1")
    Set d = CreateObject("scripting.dictionary")
    arr = ws.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1)) = arr(i, 2)
    Next
    brr = sht.Range("a1:l" & sht.Cells(Rows.Count, 1).End(3).Row)
    For i = 1 To UBound(brr)
        For j = 1 To UBound(brr, 2)
            If brr(i, j) <> Empty Then
                If d.exists(brr(i, j)) Then
                    sht.Cells(i, j).Interior.ColorIndex = 3           '给型号标红色
                    brr(i + 2, j) = d(brr(i, j))
                    sht.Cells(i + 2, j).Interior.ColorIndex = 6         '给结果标黄色
                End If
            End If
        Next
    Next
    sht.Range("a1:l" & sht.Cells(Rows.Count, 1).End(3).Row) = brr
    Beep
    Set d = Nothing
End Sub

pjypl1688888

quqiyuan 发表于 2024-9-7 12:26
代码如下。。。
Sub test1()         '不删除合并行方法
    Dim rng As Range

谢谢，谢谢你在百忙之中帮我写这么长的代码