我的工作簿：
我有一本工作簿，在其中，我有三张不同的工作表。表1是PDF文件中的一些数据，我在其中使用TextToColumns在单元格中对齐。表2包含来自我们的财务数据库的数据，而它已经分成了单元格。表3比较了表1和表2中的两组数据。
我的问题：
工作表1中的数据与工作表2中的数据具有相同的发票和信用证编号，但付款的附录编号不会相加，因为它是两个不同的公司。但是，表2中的附录编号类似于“5786”，而表1中的附录编号是空白的。
除此之外，工作表2中的附录编号分为付款和折扣。
我还没有开始编写代码，因为我不知道如何让它循环访问重复项。
我的代码：
Sub CopyPasteDataLookingForHeader()
Dim sht, sht2, sht3 As Worksheet
Dim i, LastRow, LastRow1, LastRow2, LastRow3, LastRow4, LastRow5 As Long
Dim FindNo, Number, NumberOne, FindAmount, Amount, AmountOne As String
Dim FindNo2, Number2, NumberTwo, FindAmount2, Amount2, AmountTwo As String
Dim FindDate, Dato, DateOne, FindDate2, Dato2, DateTwo As String
Set sht = Sheets("Kvik kontoudtog")
Set sht2 = Sheets("Navision kontoudtog")
Set sht3 = Sheets("Afstemning")
'------------------------------------------------------------------------------------------------
Dim i21, LastRow21, LastRowDateSub As Long
Dim FindDate21, DateSub, FindDateOffset, FindDescrip, DescripSub, FindDescripOffset As String
Dim rng9, rng10, rng11, c, celle, Rw As Range
'CONVERT INTO TEXT TO COLUMNS AND ALIGN COLUMNS
sht.Activate
'DELETE UNWANTED ROWS' TEXT
FindDate21 = sht.Range("1:1").Find("Bogføringsdato", Lookat:=xlWhole).Address(False, False, xlA1)
DateSub = sht.Application.WorksheetFunction.Substitute(FindDate21, 1, "")
FindDateOffset = sht.Range(FindDate21).Offset(1, 0).Address(False, False, xlA1)
LastRowDateSub = sht.Cells(sht.Rows.Count, DateSub).End(xlUp).Row
rng1 = FindDateOffset & ":" & DateSub & LastRowDateSub
Set rng10 = Range(rng1)
For Each c In rng10.Cells
If TypeName(c.Value) <> "Date" Then
c.EntireRow.ClearContents
End If
Next c
'INSERT CELLS NEXT TO "Kontantrabat" AND "Rente"
FindDescrip = sht.Range("1:1").Find("Beskrivelse", Lookat:=xlWhole).Address(False, False, xlA1)
DescripSub = sht.Application.WorksheetFunction.Substitute(FindDescrip, 1, "")
LastRow21 = sht.Cells(Rows.Count, DescripSub).End(xlUp).Row
DescripSub2 = sht.Application.WorksheetFunction.Substitute(FindDescrip, 1, LastRow21)
FindDescripOffset = sht.Range(FindDescrip).Offset(1, 0).Address(False, False, xlA1)
Set rng9 = Range(FindDescripOffset, DescripSub2)
For Each c In rng9.Cells
If c = "Kontantrabat" Then
c.Offset(0, 1).Insert Shift:=xlShiftToRight
End If
Next c
For Each c In rng9.Cells
If c = "Rente" Then
CValue = c.Address(False, False, xlA1)
CValueOffset = Range(CValue).Offset(0, 1).Address(False, False, xlA1)
sht.Range(CValue).Value = Range(CValue).Value & " " & Range(CValueOffset).Value
sht.Range(CValueOffset).Delete Shift:=xlToLeft
End If
Next c
'----------------------------------------------------------------------------------------------
'CONTINUE TO DELETE THE UNWANTED ROWS
Application.ScreenUpdating = False
rng10.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
FindSaldo = sht.Range("1:1").Find("Saldo", Lookat:=xlWhole).Address(False, False, xlA1)
SaldoSub = sht.Application.WorksheetFunction.Substitute(FindSaldo, 1, "")
FindSaldoOffset = sht.Range(FindSaldo).Offset(1, 0).Address(False, False, xlA1)
LastRowSaldoSub = sht.Cells(sht.Rows.Count, SaldoSub).End(xlUp).Row
rng12 = FindSaldoOffset & ":" & SaldoSub & LastRowSaldoSub
Set rng11 = Range(rng12)
Application.ScreenUpdating = False
rng11.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
'---------------------------------------------------------------------------------------------------
'CENTER TEXT IN "Bilagsnr."
FindBilagsnr = sht.Range("1:1").Find("Bilagsnr.", Lookat:=xlWhole).Address(False, False, xlA1)
BilagsnrSub = sht.Application.WorksheetFunction.Substitute(FindBilagsnr, 1, "")
LastRow2 = sht.Cells(sht.Rows.Count, BilagsnrSub).End(xlUp).Row
BilagsnrOffset = Range(FindBilagsnr).Offset(1, 0).Address(False, False, xlA1)
rng3 = BilagsnrOffset & ":" & BilagsnrSub & LastRow2
sht.Range(rng3).HorizontalAlignment = xlCenter
'---------------------------------------------------------------------------------
'ALIGN ROWS IN "NAVISION KONTOUDTOG"
sht2.Activate
FindNo1 = sht2.Range("1:1").Find("Eksternt bilagsnr.").Address(False, False, xlA1)
Number1 = Application.WorksheetFunction.Substitute(FindNo1, 1, "")
LastRowNumber1 = sht2.Cells(sht.Rows.Count, Number1).End(xlUp).Row
rng1171 = FindNo1 & ":" & Number1 & LastRowNumber1
Set rng15 = Range(rng1171)
For Each celle In rng15.Cells
If celle = "10000" Then
celle.Insert Shift:=xlShiftToRight
End If
Next celle
'----------------------------------------------------------------------------------
'CENTER TEXT IN "Eksternt bilagsnr."
FindEBilagsnr = sht2.Range("1:1").Find("Eksternt bilagsnr.").Address(False, False, xlA1)
EBilagsnrSub = sht2.Application.WorksheetFunction.Substitute(FindEBilagsnr, 1, "")
LastRow2E = sht2.Cells(sht.Rows.Count, EBilagsnrSub).End(xlUp).Row
EBilagsnrOffset = Range(FindEBilagsnr).Offset(1, 0).Address(False, False, xlA1)
rng4 = EBilagsnrOffset & ":" & EBilagsnrSub & LastRow2E
sht2.Range(rng4).HorizontalAlignment = xlCenter
'------------------------------------------------------------------------------
'INSERT CELLS FOR ENTIRE COLUMN "VALUTAKODE"
FindValuta = sht2.Range("1:1").Find("Valutakode").Address(False, False, xlA1)
ValutaSub = sht2.Application.WorksheetFunction.Substitute(FindValuta, 1, "")
LastRowValuta = sht2.Cells(sht2.Rows.Count, ValutaSub).End(xlUp).Row
ValutaOffset = sht2.Range(FindValuta).Offset(1, 0).Address(False, False, xlA1)
rng111 = ValutaOffset & ":" & ValutaSub & LastRowValuta
Range(rng111).Insert Shift:=xlShiftToRight
'-------------------------------------------------------------------------------
'COMPARING PROCESS
FindNo = sht.Range("1:1").Find("Bilagsnr.").Address(False, False, xlA1)
Number = Application.WorksheetFunction.Substitute(FindNo, 1, "")
NumberOne = FindNo
FindNo2 = sht2.Range("1:1").Find("Eksternt bilagsnr.").Address(False, False, xlA1)
Number2 = Application.WorksheetFunction.Substitute(FindNo2, 1, "")
NumberTwo = FindNo2
FindAmount = sht.Range("1:1").Find("Oprindeligt beløb").Address(False, False, xlA1)
Amount = Application.WorksheetFunction.Substitute(FindAmount, 1, "")
AmountOne = FindAmount
FindAmount2 = sht2.Range("1:1").Find("Beløb").Address(False, False, xlA1)
Amount2 = Application.WorksheetFunction.Substitute(FindAmount2, 1, "")
AmountTwo = FindAmount2
FindDate = sht.Range("1:1").Find("Bogføringsdato").Address(False, False, xlA1)
Dato = Application.WorksheetFunction.Substitute(FindDate, 1, "")
DateOne = FindDate
FindDate2 = sht.Range("1:1").Find("Bogføringsdato").Address(False, False, xlA1)
Dato2 = Application.WorksheetFunction.Substitute(FindDate2, 1, "")
DateTwo = FindDate2
LastRow = sht.Cells(sht.Rows.Count, Number).End(xlUp).Address(False, False, xlA1)
LastRow1 = sht2.Cells(sht.Rows.Count, Number2).End(xlUp).Address(False, False, xlA1)
LastRowAmount = Application.WorksheetFunction.Substitute(LastRow, Number, Amount)
LastRowAmount2 = Application.WorksheetFunction.Substitute(LastRow1, Number2, Amount2)
LastRowDate = Application.WorksheetFunction.Substitute(LastRow, Number, Dato)
LastRowDate2 = Application.WorksheetFunction.Substitute(LastRow1, Number2, Dato2)
rng1 = NumberOne & ":" & LastRow
rng2 = AmountOne & ":" & LastRowAmount
rng3 = NumberTwo & ":" & LastRow1
rng4 = AmountTwo & ":" & LastRowAmount2
rng5 = DateOne & ":" & LastRowDate
rng6 = DateTwo & ":" & LastRowDate2
'------------------------------------------
sht.Range(rng5).Copy
sht3.Activate
Range("F2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht.Range(rng1).Copy
sht3.Activate
Range("G2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht.Range(rng2).Copy
sht3.Activate
Range("H2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht2.Range(rng6).Copy
sht3.Activate
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht2.Range(rng3).Copy
sht3.Activate
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht2.Range(rng4).Copy
sht3.Activate
Range("C2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
Columns("A:H").ColumnWidth = 25
'------------------------------------------------------------------------------
'PUT IN VLOOKUP
sht3.Range(FindAmount).Offset(1, 1).Value = "VLOOKUP"
FindVLOOKUP = sht3.Range("2:2").Find("VLOOKUP").Address(False, False, xlA1)
VLOOKUP1 = sht3.Application.WorksheetFunction.Substitute(FindVLOOKUP, 2, "")
FindVLOOKUPOffset = sht3.Range(FindVLOOKUP).Offset(1, 0).Address(False, False, xlA1)
sht3.Range(FindVLOOKUPOffset).Formula = "=IFERROR(VLOOKUP(G3,$B$3:$C$10000,2,False),0)+H3"
'FILL VLOOKUP TO LASTROW
FindAmount3 = sht3.Range("1:1").Find("Kvik kontoudtog").Address(False, False, xlWhole)
Amount3 = sht3.Application.WorksheetFunction.Substitute(FindAmount3, 1, "")
LastRowVLOOK = sht3.Application.WorksheetFunction.Substitute(LastRow, Number, Amount3)
LastRowVLOOKUP = sht3.Application.WorksheetFunction.Substitute(LastRowVLOOK, Amount3, VLOOKUP1)
sht3.Range(FindVLOOKUP).Offset(1, 0).Copy
sht3.Range(FindVLOOKUPOffset, LastRowVLOOKUP).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
End Sub
目标：
我是否有可能将两个附录号合并为一个，并将数量增加，就像我制作一个数据透视表一样。
奖金目标：
然后让代码循环通过Sheet 1中的数据，然后找出空白单元格。每当找到一个空白单元格时，它应该将数量与工作表2中的数据进行比较，如果找到匹配项（具有相反的代数符号），则应从匹配数量中取出附录编号，并将其插入空白处细胞。然后循环查找下一个空白单元格？
数据样本
我已将示例文件上传到：