第一次转移并删除重复项 [英] First transfer and remove duplicates

问题描述

我正在开发一个宏，该宏将首先传输和删除.我正在使用级联字段，有人在帮助我..

i am developing a macro which will first transfer and remove. i am using concatenated fields someone help me ..

Option Explicit


Sub transferorderdata()
Dim wkbor, wkbvl, wkbysd, wkbtr As Workbook
Dim wknm, wknm1, wknm2  As String

wknm2 = "C:\vbproject\tracker\ysdflow2.xlsx"
wknm = "d:\Open.xls" '-------Open order
wknm1 = "d:\tracker.xlsx" '------tracker file
Set wkbor = Workbooks.Open(wknm)
Set wkbtr = Workbooks.Open(wknm1)
Dim irowor, irowtro, irowtrs As Integer
Dim i, j As Integer
Dim selor, seltro As String
Dim blnor As Boolean


'__________________Ordering Compare_________________
wkbor.Sheets("Filtered").Activate
irowor = wkbor.Sheets("Filtered").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
irowtro = wkbtr.Sheets("Ordering").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row

For i = 2 To irowor
For j = 2 To irowtro

wkbor.Sheets("Filtered").Activate
  selor = wkbor.Sheets("Filtered").Cells(i, 1).Value + wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 9).Value
'MsgBox selor
seltro = wkbtr.Sheets("ordering").Cells(i, 39).Value

If selor = seltro Then
blnor = True
'MsgBox "value equal "


Else

blnor = False

End If
If blnor = True Then

wkbtr.Sheets("Ordering").Cells(j, 7).Value = wkbor.Sheets("Filtered").Cells(i, 1).Value 'order no
wkbtr.Sheets("Ordering").Cells(j, 2).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 32).Value 'sold to party
wkbtr.Sheets("Ordering").Cells(j, 9).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 13).Value 'plnt
wkbtr.Sheets("Ordering").Cells(j, 8).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 3).Value 'svo
wkbtr.Sheets("Ordering").Cells(j, 10).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 14).Value 'shtpt
wkbtr.Sheets("Ordering").Cells(j, 11).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 38).Value ' username

wkbtr.Save
Exit For

End If

If blnor = False Then
Dim irowtro1 As Integer

irowtro1 = wkbtr.Sheets("Ordering").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
wkbtr.Sheets("Ordering").Cells(irowtro1, 39).Value = selor
wkbtr.Sheets("Ordering").Cells(irowtro1, 7).Value = wkbor.Sheets("Filtered").Cells(i, 1).Value 'order no
wkbtr.Sheets("Ordering").Cells(irowtro1, 2).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 32).Value 'sold to party
wkbtr.Sheets("Ordering").Cells(irowtro1, 9).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 13).Value 'plnt
wkbtr.Sheets("Ordering").Cells(irowtro1, 8).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 3).Value 'svo
wkbtr.Sheets("Ordering").Cells(irowtro1, 10).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 14).Value 'shtpt
wkbtr.Sheets("Ordering").Cells(irowtro1, 11).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 38).Value ' username


wkbtr.Save
Exit For



End If


Next
Next


wkbtr.Save
wkbor.Close


 End Sub

它正在工作，但最后我在最终文件中留有一些重复项..
一些身体可以帮助我
谢谢
Akshay

it is working but at the end i am left with some duplicates entry in the final file..
some body help me out
Thanks
Akshay

推荐答案

aksh169:

(...)末尾(. ..)最终文件中的某些重复项.

(...) at the end (...) some duplicates entry in the final file..

那是因为两个文件中填充行的数量不同.根据您的条件，您需要跳出循环.

That''s because the count of filled rows in both files is differ. Depends on your conditions, you need to jump out the loop.

这篇关于第一次转移并删除重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！