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