比较两个sheet页中的内容,自动切换

比较两个sheet中的内容,一般是一个长图片

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal DwMilisconds As Long)

Sub 画像比較()

    Call compare("Sheet1", "Sheet2", 3000, 5)
    
End Sub



Private Sub compare(sheet1Name As String, sheet2Name As String, maxLineNumber As Integer, maxCompareCount As Integer)
    
    Dim lineNumber As Integer: lineNumber = 1
    Dim compareCount As Integer: compareCount = 0
    
    Do While lineNumber < maxLineNumber
        
        loopcount = loopcount + 1
        
        Application.Sheets(sheet1Name).Activate
        Application.StatusBar = "シート名:" & sheet1Name & "_lineNumber:" & lineNumber & "_compareCount:" & loopcount
        ActiveWindow.ScrollRow = lineNumber
        ActiveWindow.ScrollColumn = 1
        DoEvents
        Sleep 500
        
        Application.Sheets(sheet2Name).Activate
        Application.StatusBar = "シート名:" & sheet2Name & "_lineNumber:" & lineNumber & "_compareCount:" & loopcount
        ActiveWindow.ScrollRow = lineNumber
        ActiveWindow.ScrollColumn = 1
        DoEvents
        Sleep 500
        
        If loopcount Mod maxCompareCount = 0 Then
            '位置移動
            lineNumber = lineNumber + 40
            loopcount = 0
        End If
    Loop
    
End Sub

这里面,有一个 64位系统 与 32位系统需要区别的注意点。

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal DwMilisconds As Long)

64位系统时,需要使用上面的   PtrSafe

猜你喜欢

转载自blog.csdn.net/sxzlc/article/details/83062942