VBA сравнивает рабочие тетради - относительно их позиций в ряду - PullRequest
0 голосов
/ 11 октября 2019

Я пытаюсь сравнить 2 рабочие книги (лист1 из Рабочей книги1 с листом1 из Рабочей книги2) Я нашел некоторый код в Интернете и сумел заставить его работать, но проблема в следующем: - он сравнивается, если строка А1 (из Рабочей книги1) точнотак же, как строка A1 в Workbook2

НО ... строки в Workbook1 меняются местами .. они есть, но в другой строке Что я хотел бы сделать, это сравнить независимо от положения

Если в Workbook1 есть строка, соответствующая строке в Workbook2, то ничего не делать (независимо от позиции, она может быть в строке B, D, Z ... и т. Д., Но она есть). Если естьстрока в Workbook1, которая не существует в Workbook2, затем отправьте отчет. В моем примере ниже отчет открывает еще одну рабочую книгу с результатами. Появляются только пропущенные строки

Это прекрасно работает, если все строки в обеих книгах находятся в одном и том же месте ...

Может ли кто-нибудь настроить этот код ниже для поиска совпадений,независимо от местоположения?

TKS A LOT заранее.

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)

Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer

Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String

Dim report As Workbook, difference As Long

Dim row As Long, col As Integer

Set report = Workbooks.Add

With ws1.UsedRange

ws1row = .Rows.Count

ws1col = .Columns.Count

End With

With ws2.UsedRange

ws2row = .Rows.Count

ws2col = .Columns.Count

End With

maxrow = ws1row

maxcol = ws1col

If maxrow < ws2row Then maxrow = ws2row

If maxcol < ws2col Then maxcol = ws2col

difference = 0

For col = 1 To maxcol

  For row = 1 To maxrow

  colval1 = ""

  colval2 = ""

  colval1 = ws1.Cells(row, col).Formula

  colval2 = ws2.Cells(row, col).Formula

  If colval1 <> colval2 Then

 difference = difference + 1

 Cells(row, col).Formula = colval1 & "<> " & colval2

 Cells(row, col).Interior.Color = 255

 Cells(row, col).Font.ColorIndex = 2

 Cells(row, col).Font.Bold = True

  End If

Next row

Next col

Columns("A:B").ColumnWidth = 25

report.Saved = True

If difference = 0 Then

report.Close False

End If

Set report = Nothing

MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two Worksheets"

End Sub

---- Plus a button to compare. Code in button;

Set myWorkbook1 = Workbooks.Open("C:test1.xlsx")  

Compare2WorkSheets Workbooks("test2.xlsm").Worksheets("Sheet1"), myWorkbook1.Worksheets("Sheet1")
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...