按日期和门店提取不重复名字

zzq0117

ykcbf1100 发表于 2024-4-8 12:05
参与一下。。。

麻烦老师给修改一下，由于数据太大，公式运行太慢。

ykcbf1100

zzq0117 发表于 2024-4-8 16:01
麻烦老师给修改一下，由于数据太大，公式运行太慢。

姓名已提取过来，但你的公式是从另外的工作簿中提取数据的，现在看不明白。如果公式你是从这个工作簿提取数据的，那你改写一下，应该可以用VBA提取到数据。

quqiyuan

李正旺2024

Sub text()
    Dim j%, i%, Dic As Object, a, b
    Sheet1.Range("A4:A5000").ClearContents
    Set Dic = CreateObject("scripting.dictionary")
        For i = 2 To Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
         a = DateSerial(Year(Date), Sheet1.Range("C2"), Sheet1.Range("D2"))
              If Sheet2.Cells(i, 3) = a And Sheet2.Cells(i, 4) = Sheet1.Range("B2") And Not Dic.exists(Sheet2.Cells(i, "F")) Then
               ' If Not Dic.exists(Sheet2.Cells(i, "F")) Then
                    Dic(Sheet2.Cells(i, "F").Value) = ""
                'End If
              End If
        Next
        Sheet1.Range("A4").Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.keys)
End Sub

李正旺2024

李正旺2024 发表于 2024-4-8 21:38
Sub text()
    Dim j%, i%, Dic As Object, a, b
    Sheet1.Range("A4:A5000").ClearContents

第三行清空数据的A5000,可以根据数据调整一下.