Проблема с копированием данных из одной рабочей книги в другую, если данные не существуют - PullRequest
0 голосов
/ 28 марта 2019

Нам нужно скопировать данные из одной рабочей книги в другую, если данных не существует.

For example as below.
sheet1 in workbook1
Column1  column2 column 3
abc      ravi     red
def      ramu     blue 
ghi      giri     green

Sheet1 in workbook2
column1 column2  column 3
abc     ravi    black
def     ramu    blue

Теперь нам нужно сравнить столбец 1, 2 и 3 в обеих рабочих книгах, и если какие-либо данные столбца не совпадают, то данные, представленные на листе 1 рабочей книги 1, должны быть добавлены на лист 1 в рабочей книге2 без дубликатов

Я пробовал использовать указанный ниже код. Не уверен, где я допустил ошибку.

Private Sub click()
Dim x As Workbook
Dim y As Workbook


Set y = ActiveWorkbook
Set x = Workbooks.Open("workbook1.xlsx")
Set newbook = Workbooks.Open("workbook2.xls")

ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Name
ActiveWorkbook.Save

b1 = x.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
a1 = newbook.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row

 For i = 2 To a1
   For j = 2 To b1
     If (newbook.Sheets("ENV").Cells(i, 1).Value <> x.Sheets("ENV").Cells(j, 1).Value And newbook.Sheets("ENV").Cells(i, 2).Value <> x.Sheets("ENV").Cells(j, 2).Value And newbook.Sheets("ENV").Cells(i, 3).Value <> x.Sheets("ENV").Cells(j, 3).Value) Then
     x.Activate
     b = Worksheets("ENV").Cells(Rows.Count, 1).End(xlUp).Row
     x1 = x.Sheets("ENV").Cells(j, 1).Value
     y1 = x.Sheets("ENV").Cells(j, 2).Value
     z1 = x.Sheets("ENV").Cells(j, 3).Value
     x.Sheets("ENV").Cells(b + 1, 1).Value = newbook.Sheets("ENV").Cells(i, 1).Value
     x.Sheets("ENV").Cells(b + 1, 2).Value = newbook.Sheets("ENV").Cells(i, 2).Value
     x.Sheets("ENV").Cells(b + 1, 3).Value = newbook.Sheets("ENV").Cells(i, 3).Value

     End If
     Next
     Next
 End Sub

Ожидаемый результат: получить только те данные, которые не соответствуют Фактический результат: получение повторяющихся значений

1 Ответ

0 голосов
/ 28 марта 2019

Вы зацикливались слишком много раз; Кроме того, всегда присваивайте свои переменные и не используйте такие вещи, как a1, которые можно спутать с диапазоном. Вы присвоили каждую книгу Sheet1 переменной, а затем начали использовать Sheets("ENV"), что сбивает с толку. Использование And гласит, что все три ячейки должны быть изменены, а не только одна, используйте Or. В вашем вопросе не было ясно, какую книгу вы пытались обновить, поэтому я выбрал workbook1 в качестве исходной книги и newbook в качестве места назначения, если я ошибаюсь, просто измените переменные.

Sub TestRngIfNotSameUpdate()

Dim Srcewb As Workbook, Destwb As Workbook
Dim Srcews As Worksheet, Destws As Worksheet
Dim lRowSrcewb As Long

Set Srcewb = Workbooks.Open("workbook1.xlsx")
Set Destwb = Workbooks.Open("workbook2.xls")

Set Srcews = Srcewb.Sheets(ENV)
Set Destws = Destwb.Sheets(ENV)

Destwb.SaveCopyAs Filename:=Destwb.Name
Destwb.Save

lRowSrcews = Srcews.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lRowSrcews
         If Destws.Cells(i, 1).Value <> Srcews.Cells(i, 1).Value _
         Or Destws.Cells(i, 2).Value <> Srcews.Cells(i, 2).Value _
         Or Destws.Cells(i, 3).Value <> Srcews.Cells(i, 3).Value Then

            Destws.Cells(i, 1).Resize(, 3).Value = Srcews.Cells(i, 1).Resize(, 3).Value

         End If
    Next i

End Sub 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...