Я получаю данные из базы данных в файл Excel.Если я внесу изменения в базу данных и получу новый «дамп» в файле Excel, я хотел бы знать, какие изменения были внесены с момента последнего получения данных.Я довольно новичок в кодировании и встретил свои ограничения с этой проблемой.Что мне нужно сделать, это сравнить имя / идентификатор с соответствующим именем в столбце 1 для ws1 против столбца 1 для ws2 и выделить различия в ws2 для значений в каждой строке.Тем не менее, имя может находиться в отдельной строке между каждым дампом, так как новые имена добавляются / удаляются.
Я пробовал некоторый код, который просто сравнивает значения в каждой ячейке, и это здорово, если имена / идентификаторыв той же позиции строки против листа, с которым я сравниваю.Однако, если имя находится в другой строке, весь набор данных в этой строке будет считаться изменением и будет выделен.
Private Sub CommandButton1_Click()
Call compareSheets("Sheet1", "Sheet2")
End Sub
Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim mycell As Range
Dim mydiffs As Integer
'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
'If the cell has a matching value change it to "no fill"
If mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.ColorIndex = 0
End If
Next
'msg to display no. of difference found
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtSheet2).Select
End Sub
WORKSHEET 1
Tag Temperature Pressure
13L0001A1 40 20
13L0002A2 40 25
13L0003A3 35 25
WORKSHEET 2
Tag Temperature Pressure
13L0001A1 40 20
13L0002A2 45 20
13L0003A3 35 25
Это пример набора данных, который я хотел бы сопоставить.(очень упрощенно, мой фактический набор данных содержит 45 столбцов).Мне нужно выделить изменение температуры и давления для метки 13L0002A2.
Любая помощь будет высоко оценена!
РЕДАКТИРОВАТЬ: Вот новый код, который я пытаюсь реализовать:
Public Sub comparesheets(shtSheet1 As String, shtSheet2 As String)
Dim rowCount1 As Integer
Dim rowCount2 As Integer
rowCount1 = ThisWorkbook.Sheets(1).Range("D2").SpecialCells(xlCellTypeLastCell).Row
rowCount2 = ThisWorkbook.Sheets(2).Range("D2").SpecialCells(xlCellTypeLastCell).Row
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ThisWorkbook.Sheets(1).Range("D2:D" & rowCount1)
Set rng2 = ThisWorkbook.Sheets(2).Range("D2:D" & rowCount2)
Dim var As Variant, iSheet As Integer
'Cycle through all the cells in that column:
For rowCount1 = 4 To rng1
Next rowCount1
'For every cell that is not empty, search through the column "D" in each worksheet for the
'value that matches that cell value in the workbook.
If Not IsEmpty(Cells(rowCount1, 4)) Then
For iSheet = ActiveSheet.Index + 4 To Worksheets.Count
var = Application.Match(Cells(rng1, 4).Value, Worksheets(iSheet).Columns(4), 0)
Next iSheet
End If
'If a matching value is found, then search each row for differences. If difference is found, color the cell yellow.
'otherwise, continue searching until you reach the end of the workbook.
If Not IsError(var) Then
For Each rng1 In ActiveWorkbook.Worksheets(shtSheet1).UsedRange
If Not rng2.Value = rng1.Value Then
rng2.Interior.Color = vbYellow
If Not rng2.Offset(0, 1).Value = rng1.Offset(0, 1).Value Then
rng2.Offset(0, 1).Interior.Color = vbYellow
End If
' Here i get an error with "Next without For"
Next rng1
End If
' If no match is found, color entire row yellow
If IsError(var) Then
EntireRow.Interior.Color = vbYellow
End If
End Sub
Если ядобавив оператор Next после ячейки For Each, я получаю сообщение об ошибке Next без For.Если я не добавляю оператор Next, я получаю сообщение об ошибке «Блокировать, если без конца».
Какие-либо предположения относительно того, что может быть неправильным?
2-е РЕДАКТИРОВАНИЕ:
Поэтому я попытался изменить пример кода с https://docs.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.match, потому что это в значительной степени делает то, что мне нужно.Я успешно получил код для работы, один раз.Затем я очистил все форматы, чтобы повторить попытку, и столкнулся с ошибкой индекса вне диапазона ("9), и я не могу на всю жизнь выяснить, почему это работало один раз, а не сейчас.
КодЯ использовал:
Sub HighlightMatches()
'Declare variables
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean, rng1 As Range, rng2 As Range, rowCount1 As Integer, rowCount2 As Integer
rowCount1 = ThisWorkbook.Sheets(1).Range("D4").SpecialCells(xlCellTypeLastCell).Row
rowCount2 = ThisWorkbook.Sheets(2).Range("D4").SpecialCells(xlCellTypeLastCell).Row
Set rng1 = ThisWorkbook.Sheets(1).Range("D4:D" & rowCount1)
Set rng2 = ThisWorkbook.Sheets(2).Range("D4:D" & rowCount2)
'Set up the count as the number of filled rows in the first column of Sheet1.
iRowL = Cells(Rows.Count, 4).End(xlUp).Row
'Cycle through all the cells in that column:
For iRow = 4 To iRowL
'For every cell that is not empty, search through the column "D" in each worksheet in the
'workbook for a value that matches that cell value.
If Not IsEmpty(Cells(iRow, 4)) Then
For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
bln = False
var = Application.Match(Cells(iRow, 4).Value, Worksheets(iSheet).Columns(4), 0)
'If you find a matching value, indicate success by setting bln to true and exit the loop;
'otherwise, continue searching until you reach the end of the workbook.
If Not IsError(var) Then
bln = True
Exit For
End If
Next iSheet
End If
'If match is found, compare row for each colum;
'if no match is found, color cell yellow.
If Not bln = True Then
For Each rng1 In ThisWorkbook.Worksheets(1).UsedRange
If Not rng1.Value = ThisWorkbook.Worksheets(2).Cells(rng2.Row, 4) Then
rng1.Interior.ColorIndex = vbYellow
End If
Next rng1
End If
Next iRow
End Sub