0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

DBDUMP.xlsm
Option Explicit
'グローバル関数
Dim StartCol As Long

'シートを作成する
Sub DiffSheetCleate()
 Worksheets().Add After:=Worksheets(Worksheets.Count)
 ActiveSheet.Name = "diff"
End Sub

'セルの最終行の値(D列)を取得する
Function EndSheetRow(ByVal str As String)
Dim LastRow As Long
Dim EndRow As Long
Worksheets(str).Activate
EndRow = ActiveSheet.Rows.Count
LastRow = Cells(EndRow, StartCol).End(xlUp).row 'Cells(行, 列)と表す
'MsgBox "最終行は" & LastRow & "デス" '確認用コメント
EndSheetRow = LastRow
End Function

'☆現新の最終行の値(D列)を取得するし、値の多いほうをコピーする
Sub CopySheet()
Dim NowRows, NewRows As Long
Dim CopySheetName As String
NowRows = EndSheetRow("現")
NewRows = EndSheetRow("新")
'最終行が多い方を取得する
CopySheetName = IIf(NowRows >= NewRows, "現", "新")
'MsgBox CopySheetName & "をコピーします" '確認用コメント
 Worksheets(CopySheetName).Copy After:=Worksheets(Worksheets.Count)
 ActiveSheet.Name = "diff"
End Sub

'☆diffで比較対象のセルを取得する
Sub comparisonCell()
'StartCol = 3 '決め打ちでC列とする。(変更したければしてね)
Worksheets("diff").Activate
'対象セルの選定
 '最後の行の確認
Dim SheetLastRow As Long
Dim EndRow As Long
EndRow = ActiveSheet.Rows.Count
SheetLastRow = Cells(EndRow, StartCol).End(xlUp).row 'Cells(行, 列)と表す
'C列の先頭の値を取得する
Dim TableFirstRow As Long 'テーブル先頭の列を記憶する変数
Dim EndTableRow As Long 'テーブル最後の列を記憶する変数
Dim EndTableCol As Long 'テーブル最後の行を記憶する変数
Dim TableFirstValue As String 'テーブル先頭の値を取得
Dim CountRow As Long 'テーブル比較の行数カウント変数
Dim CountCol As Long 'テーブル比較の列数カウント変数

'取得テーブルの先頭と終わりの行数と列数を取得する(初回分)
TableFirstRow = Cells(1, StartCol).End(xlDown).row
TableFirstValue = Cells(TableFirstRow + 1, StartCol).Value
If TableFirstValue = "" Then
  EndTableRow = TableFirstRow
Else
  EndTableRow = Cells(TableFirstRow, StartCol).End(xlDown).row
  EndTableCol = Cells(TableFirstRow, StartCol).End(xlToRight).Column
  'MsgBox "TableFirstRow" & TableFirstRow & "EndTableRow" & EndTableRow & "EndTableCol" & EndTableCol '確認用コメント
  'MsgBox "TableFirstValue" & TableFirstValue  '確認用コメント
  'テーブルの行数分(EndTableRow-TableFirstRow)判定を行う
  For CountRow = TableFirstRow + 1 To EndTableRow Step 1
    For CountCol = StartCol To EndTableCol Step 1
      '値の比較を行う
       comparison CountRow, CountCol
    Next CountCol
  Next CountRow
End If

'取得テーブルの先頭と終わりの行数と列数を取得する(2個目以降)
'↑の処理をシートの最後まで繰り返す
Do While EndTableRow < SheetLastRow

  TableFirstRow = Cells(EndTableRow, StartCol).End(xlDown).row
  TableFirstValue = Cells(TableFirstRow + 1, StartCol).Value
  If TableFirstValue = "" Then
    EndTableRow = TableFirstRow
  Else
  EndTableRow = Cells(TableFirstRow, StartCol).End(xlDown).row
  EndTableCol = Cells(TableFirstRow, StartCol).End(xlToRight).Column
  'MsgBox "TableFirstRow" & TableFirstRow & "EndTableRow" & EndTableRow & "EndTableCol" & EndTableCol '確認用コメント
    'テーブルの行数分(EndTableRow-TableFirstRow)判定を行う
    For CountRow = TableFirstRow + 1 To EndTableRow Step 1
      For CountCol = StartCol To EndTableCol Step 1
        '値の比較を行う
         comparison CountRow, CountCol
      Next CountCol
    Next CountRow
  End If
Loop
End Sub

'比較用の関数(引数:diffシートの対象セル)
Sub comparison(row As Long, col As Long)
'各セルの値を取得する変数
Dim NowCellValue, NewCellValue As String
Worksheets("現").Activate
NowCellValue = Cells(row, col).Value
Worksheets("新").Activate
NewCellValue = Cells(row, col).Value
Worksheets("diff").Activate
If NowCellValue = NewCellValue Then
Cells(row, col).Value = "TRUE"
Else
Cells(row, col).Value = "FALSE"
Cells(row, col).Font.Color = RGB(127, 0, 20)
Cells(row, col).Interior.Color = RGB(252, 150, 200)

End If
End Sub

'拡張機能
'対象外のカラムの排除

'ボタンクリック時のマクロ
Sub ボタン1_Click()
  StartCol = 3 '決め打ちでC列とする。(変更したければしてね)
  CopySheet
  comparisonCell
End Sub


0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?