请教怎样自动添加新数据

waw751115

请教大侠们：怎样在下表中自动添加新数据啊？

shiruiqiang

a列做字典，查询d列，不存在就复制过去

shiruiqiang

Sub test()
Dim arr
Dim rng As Range
Dim dic
Set dic = CreateObject("scripting.dictionary")

Sheets(1).[j3:j100].ClearContents

arr = Sheets(1).[a1].CurrentRegion
For x = 1 To UBound(arr)
If Len(arr(x, 1)) Then
dic(arr(x, 1)) = ""
End If
Next

For Each rng In Range("i3:i" & Range("i65536").End(xlUp).Row)
If dic.exists(rng.Value) Then
rng.Offset(0, 1) = "已存在"
Else
rng.Offset(0, 1) = "第一次"
rng.Copy Range("a" & Range("a65536").End(xlUp).Row + 1)
End If
Next

End Sub

waw751115

shiruiqiang 发表于 2024-9-15 08:36
Sub test()
Dim arr
Dim rng As Range

谢谢您的解答，请问一下，假如数据和查询不在同一个表(一个数据表和一个查询表)，最后一行代码应该怎样改动啊

waw751115

shiruiqiang 发表于 2024-9-15 08:36
Sub test()
Dim arr
Dim rng As Range

请问怎样送鲜花啊

ynzsvt

1. Sub test()
   
2. Dim Arr, Brr, x&
   
3. Dim rng As Range
   
4. Dim Dic
   
5. Set Dic = CreateObject("scripting.dictionary")
   
6. 
   
7. Brr = Sheet2.[A1].CurrentRegion
   
8. Arr = Sheet1.[A1].CurrentRegion
   
9. 
   
10. For x = 1 To UBound(Arr)
    
11.   If Len(Arr(x, 1)) Then
    
12.    Dic(Arr(x, 1)) = ""
    
13.   End If
    
14. Next
    
15. 
    
16. For x = 2 To UBound(Brr)
    
17.   If Dic.exists(Brr(x, 1)) Then
    
18.    Brr(x, 2) = "已存在"
    
19.   Else
    
20.    Brr(x, 2) = "第一次"
    
21.    Dic(Brr(x, 1)) = ""
    
22.   End If
    
23. Next
    
24. 
    
25. Sheet1.[A1].Resize(Dic.Count) = Application.WorksheetFunction.Transpose(Dic.keys)
    
26. Sheet2.[A1].CurrentRegion = Brr
    
27. End Sub

复制代码

waw751115 发表于 2024-9-15 17:00
请问怎样送鲜花啊

点右下角的评分。

waw751115

ynzsvt 发表于 2024-9-15 17:04
点右下角的评分。

谢谢，可以帮忙看一下代码吗

ynzsvt

waw751115 发表于 2024-9-15 17:05
谢谢，可以帮忙看一下代码吗

在6楼更新了。

waw751115

ynzsvt 发表于 2024-9-15 17:04
waw751115 发表于 2024-9-15 17:00
请问怎样送鲜花啊

您好，假如sheet1中不全部是数字，还包含大小写字母的话，怎样匹配大小写来查询啊？假如在sheet2中输入abd的话，也能匹配查找到大写的ABD

ynzsvt

waw751115 发表于 2024-9-21 07:46
您好，假如sheet1中不全部是数字，还包含大小写字母的话，怎样匹配大小写来查询啊？假如在sheet2中输入ab ...

那主要是看你自己需求的结果是大写还是小写，甚至特殊的需求，才好继续。提问一定要完整，不应该是挤牙膏的形式。