检查记录是否存在并将记录追加到底部

分类：编程问答

如何解决检查记录是否存在并将记录追加到底部

我有一段修改过的代码，我一直在使用，但是效率很低。目的是检查“ Login1”中是否存在“ Database1”表中的记录，如果没有，则不执行任何操作，否则将记录不添加到第一行。 Log1中有一个记录的多次迭代。在Database1中，记录总是应该只有一个实例。

  1. 每次运行代码时，它都会替换Database1中的所有记录。

  2. 这似乎是在欺骗row1 database1与row1 Log1，而不是整个范围，因此即使它已经存在，它也会为一条记录复制多个条目。

有人可以帮忙吗？抱歉，如果我不清楚，请提出要求，我会在需要时补充更多细节。

Option Explicit

Sub Checkrecordthenaddifnotexists()
    Dim Ws As Worksheet
    Dim i As Long,j As Long
    Dim k As Long
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell  As Range
    Dim objTable   As ListObject

    Application.Calculation = xlCalculationAutomatic

    Set sht = Worksheets("Database1")
    Sheets("Database1").Select
    Cells.Select
    sht.Sort.SortFields.Clear

    sht.Sort.SortFields.Add Key:=Range("A:A"),_
        SortOn:=xlSortOnValues,Order:=xlAscending,_
        DataOption:=xlSortTextAsNumbers

    With ActiveWorkbook.Worksheets("Database1").Sort
        .SetRange Range("A:AB")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Log1").Select
    Cells.Select
    ActiveWorkbook.Worksheets("Log1").Sort.SortFields.Clear
  
    ActiveWorkbook.Worksheets("Log1").Sort.SortFields.Add Key:=Range("B:B"),_
    SortOn:=xlSortOnValues,DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Log1").Sort
        .SetRange Range("A:AJ")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    sht.Activate
    Set StartCell = Range("A2")
    LastRow = sht.Cells(sht.Rows.Count,StartCell.Column).End(xlUp).Row
    LastColumn = sht.Cells(StartCell.Row,sht.Columns.Count).End(xlToLeft).Column
    On Error Resume Next
    'Sheet2.ShowAllData
    Sheet2.Select
    Selection.AutoFilter
    On Error GoTo 0

    sht.Range(StartCell,sht.Cells(LastRow,LastColumn)).Select
    Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange,Selection,xlYes)
    
    With ActiveSheet
        .ListObjects(1).Name = "Database_v0.1"
    End With

    Set Ws = Sheets("Database1")
    Dim RowsMaster As Integer,Rows2 As Integer
    RowsMaster = Ws.Cells(1048576,1).End(xlUp).Row
    Rows2 = Worksheets("Log1").Cells(1048576,2).End(xlUp).Row
  
    With Worksheets("Log1")
        For i = 2 To Rows2
            For j = 2 To RowsMaster + 1
                If .Cells(i,1) = Ws.Cells(j,1) Then
                    Exit For
                End If
            Next j
            If j = RowsMaster + 1 Then
                RowsMaster = RowsMaster + 1
                For k = 2 To 8
                    Ws.Cells(RowsMaster,k - 1) = .Cells(i,k)
                Next
            End If
  
        Next i
  
    End With
  
    Sheets("Database1").Activate
    ActiveSheet.ListObjects("Database_v0.1").Unlist
    Range("A1").Select
    Range(Selection,Selection.End(xlToRight)).Select
    Range(Selection,Selection.End(xlDown)).Select
    ActiveSheet.Range("A1:NT1048576").RemoveDuplicates Columns:=1,Header:=xlYes
    Sheets("Database Repository").Columns("A").Select
    Selection.NumberFormat = "0"
    Sheet2.Select
    Selection.AutoFilter
    Application.Calculation = xlCalculationAutomatic
End Sub

解决方法

这应该对您有帮助，整个解释在代码中：

Option Explicit
Sub Checkrecordthenaddifnotexists()

    Application.Calculation = xlCalculationAutomatic
    'Try to declare your variables where you are using them
    'You sort 2 times,different sheets but mostly same way so,'write another procedure with variable and give them as you need
    'the procedure below needs:
    'sheet to be sorted,which range will be the one to sort,the starting cell
    SortMySheet ThisWorkbook.Sheets("Database1"),"A:A",ThisWorkbook.Sheets("Database1").Range("A2")
    SortMySheet ThisWorkbook.Sheets("Log1"),ThisWorkbook.Sheets("Log1").Range("A2") 'change the starting cell

    'Now we will change your approach to use 2 arrays and 1 dictionary
    'For that you need to go to tools-References- and then check the Microsoft Scripting Runtime reference
    'This is assuming you want to add the new entries from sheet Log1 to DataBase1 when they not exist in the later.
    
    'The arrays:
    With ThisWorkbook.Sheets("DataBase1")
        Dim arrMaster As Variant: arrMaster = LoadArray(ThisWorkbook.Sheets("Database1"),.Range("A2")) 'change the starting cell
    End With
    With ThisWorkbook.Sheets("Log1")
        Dim arrLog As Variant: arrLog = LoadArray(ThisWorkbook.Sheets("Log1"),.Range("A2")) 'change the starting cell
    End With
    
    'The dictionary:
    Dim IdDictionary As Dictionary: Set IdDictionary = LoadDictionary(arrMaster)

    'Now the hardwork,getting the new items to the sheet Log1
    AddNewEntries arrMaster,arrLog,IdDictionary

'   the next 6 lines of code are useless,we didn't need to make a table,we are not going to have duplicates
'    Sheets("Database1").Activate
'    ActiveSheet.ListObjects("Database_v0.1").Unlist
'    Range("A1").Select
'    Range(Selection,Selection.End(xlToRight)).Select
'    Range(Selection,Selection.End(xlDown)).Select
'    ActiveSheet.Range("A1:NT1048576").RemoveDuplicates Columns:=1,Header:=xlYes

'   the next 4 lines of code I don't get
'    Sheets("Database Repository").Columns("A").Select
'    Selection.NumberFormat = "0"
'    Sheet2.Select
'    Selection.AutoFilter

    Application.Calculation = xlCalculationAutomatic
    
End Sub
Private Sub SortMySheet(ws As Worksheet,KeyRange As String,StartCell As Range)
    
    With ws
        'Get the last row and column for your whole range
        Dim LastRow As Long: LastRow = .Cells(.Rows.Count,StartCell.Column).End(xlUp).Row
        Dim LastColumn As Long: LastColumn = .Cells(StartCell.Row,.Columns.Count).End(xlToLeft).Column
        'Sort your whole range
        .Sort.SortFields.Clear
        .Sort.SortFields.Add .Range(KeyRange),xlSortOnValues,xlAscending,xlSortTextAsNumbers
        With .Sort
            .SetRange ws.Range(StartCell,ws.Cells(LastRow,LastColumn))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

End Sub
Private Function LoadArray(ws As Worksheet,StartCell As Range) As Variant
    
    With ws
        Dim LastRow As Long: LastRow = .Cells(.Rows.Count,.Columns.Count).End(xlToLeft).Column
        LoadArray = .Range(StartCell,.Cells(LastRow,LastColumn))
    End With
    
End Function
Private Function LoadDictionary(arr As Variant) As Dictionary
    
    Set LoadDictionary = New Dictionary
    'By default dictionaries are Case sensitive,if you need to check without that then:
    'LoadDictionary.CompareMode = TextCompare
    'Uncheck the comment from the line above,by default I'll go with case Sensitive
    Dim i As Long
    For i = 1 To UBound(arr)
        If Not LoadDictionary.Exists(arr(i,1)) Then LoadDictionary.Add arr(i,1),i
    Next i
    
End Function
Private Sub AddNewEntries(arrMaster As Variant,arrLog As Variant,IdDictionary As Dictionary)
    
    With ThisWorkbook.Sheets("DataBase1")
        Dim i As Long,j As Long
        Dim LastRow As Long
        'Loop through all entries in arrLog
        For i = 2 To UBound(arrLog)
            'If the entry doesn't exist in the DataBase sheet then
            If Not IdDictionary.Exists(arrLog(i,1)) Then
                'Calculate the first free row of data in column A for DataBase1
                LastRow = .Cells(.Rows.Count,1).End(xlUp).Row + 1
                'Loop through first to last column in arrLog and paste it to DataBase1
                For j = 1 To UBound(arrLog,2)
                    .Cells(LastRow,j) = arrLog(i,j)
                Next j
            End If
        Next i
    End With
    
End Sub

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog.csdn.net/weixin_42420249/article/details/81191861 依赖版本报错：更换其他版本 无法下载依赖可参考：https://blog.csdn.net/weixin_42628809/a
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下 2021-12-03 13:33:33.927 ERROR 7228 [ main] o.s.b.d.LoggingFailureAnalysisReporter : *************************** APPL
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://blog.csdn.net/weixin_43501566/article/details/112482302 # 在gradle-wrapper.properties 添加以下内容 org.gradle.jvmargs=-Df
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起作用 <select id="xxx"> SELECT di.id, di.name, di.work_type, di.updated... <where> <if test=&qu
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct redisServer’没有名为‘server_cpulist’的成员 redisSetCpuAffinity(server.server_cpulist); ^ server.c: 在函数‘hasActiveC
微服务启动错误：Command line is too long. Shorten command line for
解决方案1 1、改项目中.idea/workspace.xml配置文件，增加dynamic.classpath参数 2、搜索PropertiesComponent，添加如下 <property name="dynamic.classpath" value="tru
vue常见错误
删除根组件app.vue中的默认代码后报错：Module Error (from ./node_modules/eslint-loader/index.js): 解决方案：关闭ESlint代码检测，在项目根目录创建vue.config.js，在文件中添加 module.exports = { lin
spark常见错误
查看spark默认的python版本 [root@master day27]# pyspark /home/software/spark-2.3.4-bin-hadoop2.7/conf/spark-env.sh: line 2: /usr/local/hadoop/bin/hadoop: No s
matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd import matplotlib.pyplot as plt # 设置字体 plt.rcParams['font.sans-serif'] = ['SimHei'] # 能正确显示负号 p
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：controller层有一个接口，访问该接口时报错：Request method ‘DELETE‘ not supported 错误原因：没有接收到前端传入的参数，修改为如下 参考 错误2：cannot r
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon: driver failed programming external connectivity on endpoint quirky_allen 解决方法：重启docker -> systemctl r
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Altʾnter快捷键，选择第2项 参考：https://blog.csdn.net/shi_hong_fei_hei/article/details/88814070 错误2：启动时报错，不能找到主启动类 #
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirement already satisfied: pip in c:\users\ychen\appdata\local\programs\python\python310\lib\site-packages (22.0.4) Coll
maven常见错误
错误1：maven打包报错 错误还原：使用maven打包项目时报错如下 [ERROR] Failed to execute goal org.apache.maven.plugins:maven-resources-plugin:3.2.0:resources (default-resources)
cloud项目中常见错误
错误1：服务调用时报错 服务消费者模块assess通过openFeign调用服务提供者模块hires 如下为服务提供者模块hires的控制层接口 @RestController @RequestMapping("/hires") public class FeignControl
springboot常见错误
错误1：运行项目后报如下错误 解决方案 报错2：Failed to execute goal org.apache.maven.plugins:maven-compiler-plugin:3.8.1:compile (default-compile) on project sb 解决方案：在pom.
springmvc拦截器中使用redisTemplate报空指针异常
参考 错误原因 过滤器或拦截器在生效时，redisTemplate还没有注入 解决方案：在注入容器时就生效 @Component //项目运行时就注入Spring容器 public class RedisBean { @Resource private RedisTemplate<String
vite报错：npm ERR! command C:WINDOWSsystem32cmd.exe /d /s /c C:UsersychenAppDataLocalTempnpx-dde1c848.cmd
使用vite构建项目报错 C:\Users\ychen\work>npm init @vitejs/app @vitejs/create-app is deprecated, use npm init vite instead C:\Users\ychen\AppData\Local\npm-
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot