powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / сравнение
8 сообщений из 33, страница 2 из 2
сравнение
    #33836637
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
сравнение папок
...
Рейтинг: 0 / 0
сравнение
    #33839442
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
сравнение книг

авторI have to check the contents of a large spreadsheet against a second more
up to date spreadsheet in another workbook. The structure of the 2 workbooks
is the same. How can I identify which cells differ so I can investigate
those individually.

This procedure creates a new workbook which lists the comparison results for
each worksheet in the two workbooks of interest. Each of the two workbooks
should be open prior to running this procedure. Replace the dummy names in the
the DoCompare sub with appropriate filenames.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
Sub DoCompare()
  Dim WS As Worksheet
  Workbooks.Add
  For Each WS In WorkBooks("SomeBook.xls").Worksheets
    CompareSheets WS, Workbooks("SomeOther.xls").Worksheets(WS.Name)
  Next
End Sub

Sub CompareSheets(WS1 As Worksheet, WS2 As Worksheet)
  Dim iRow As Integer, iCol As Integer
  Dim R1 As Range, R2 As Range
  Worksheets.Add.Name = WS1.Name ' new book for the results
  Range("A1:D1").Value = Array("Address", "Difference", WS1.Parent.Name, WS2.Parent.Name)
  Range("A2").Select
  For iRow =  1  To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Row, _
                      WS2.Range("A1").SpecialCells(xlLastCell).Row)
    For iCol =  1  To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Column, _
                      WS2.Range("A1").SpecialCells(xlLastCell).Column)
      
      Set R1 = WS1.Cells(iRow, iCol)
      Set R2 = WS2.Cells(iRow, iCol)
      
      ' compare the types to avoid getting VBA type mismatch errors.
      If TypeName(R1.Value) <> TypeName(R2.Value) Then
        NoteError R1.Address, "Type", R1.Value, R2.Value
      ElseIf R1.Value <> R2.Value Then
        If TypeName(R1.Value) = "Double" Then
          If Abs(R1.Value - R2.Value) > R1.Value *  10  ^ (- 12 ) Then
            NoteError R1.Address, "Double", R1.Value, R2.Value
          End If
        Else
            NoteError R1.Address, "Value", R1.Value, R2.Value
        End If
      End If
      
      ' record formulae without leading "=" to avoid them being evaluated
      If R1.HasFormula Then
        If R2.HasFormula Then
          If R1.Formula <> R2.Formula Then
            NoteError R1.Address, "Formula", Mid(R1.Formula,  2 ), Mid(R2.Formula,  2 )
          End If
        Else
          NoteError R1.Address, "Formula", Mid(R1.Formula,  2 ), "**no formula**"
        End If
      Else
        If R2.HasFormula Then
          NoteError R1.Address, "Formula", "**no formula**", Mid(R2.Formula,  2 )
        End If
      End If
      If R1.NumberFormat <> R2.NumberFormat Then
        NoteError R1.Address, "NumberFormat", R1.NumberFormat, R2.NumberFormat
      End If
    Next iCol
  Next iRow
  With ActiveSheet.UsedRange.Columns
    .AutoFit
    .HorizontalAlignment = xlLeft
  End With
End Sub

Sub NoteError(Address As String, What As String, V1, V2)
  ActiveCell.Resize( 1 ,  4 ).Value = Array(Address, What, V1, V2)
  ActiveCell.Offset( 1 ,  0 ).Select
  If ActiveCell.Row = Rows.Count Then
    MsgBox "Too many differences", vbExclamation
    End
  End If
End Sub
...
Рейтинг: 0 / 0
сравнение
    #33839768
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
сравнение
    #33840259
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
сравнение
    #33840273
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
сравнение
    #33890558
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
http://nezavisim.com/?cat=2&scat=8 - бесплатная утилита для сравнения книг экселя.
...
Рейтинг: 0 / 0
сравнение
    #33934300
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
сравнение
    #34194055
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
штука
...
Рейтинг: 0 / 0
8 сообщений из 33, страница 2 из 2
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / сравнение
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]