Excel VBA Examples

De WikiMar
La revisió el 18:16, 20 feb 2013 per Marti (discussió | contribucions) (Es crea la pàgina amb «<syntaxhighlight lang="vb"> Public Sub compareTables() ' For i = 1 To 917 ' str1 = Sheets(1).Cells(i, 1) ' str1b = Trim(Left(str1, InStr(str1, " ") ...».)
(dif.) ← Versió més antiga | Versió actual (dif.) | Versió més nova → (dif.)
Salta a la navegació Salta a la cerca
Public Sub compareTables()
    
'    For i = 1 To 917
'        str1 = Sheets(1).Cells(i, 1)
'        str1b = Trim(Left(str1, InStr(str1, " ") - 1))
'
'        For j = 1 To 964
'            str2 = Trim(Sheets(2).Cells(j, 7))
'            If Left(str2, Len(str1b)) = str1b Or Left(str1b, Len(str2)) = str2 Then
'                Sheets(1).Cells(i, 6) = Sheets(2).Cells(j, 6)
'            End If
'        Next j
'    Next i

    
    Dim varSheetA As Variant
    Dim varSheetB As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long
    Dim iRowB As Long
    
    
    'strRangeToCheck = "A1:IV65536"
    strRangeToCheck = "A1:Z1000"

    'Loading the whole table into memory to speed up the comparition process. Excel takes a lot of time if comparing cell by cell!:
    'Debug.Print Now
    varSheetA = Worksheets("Postgres").Range(strRangeToCheck)
    varSheetB = Worksheets("ITSM").Range(strRangeToCheck)
    'Debug.Print Now
    
    For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)

        'We search for the Row number containing the same SN on the second table:
        Found = False
        For iRowB = LBound(varSheetB, 1) To UBound(varSheetB, 1)
            'Debug.Print LBound(varSheetB, 1); " "; UBound(varSheetB, 1)
            'Debug.Print iRow; ": "; varSheetA(iRow, 4); " - "; iRowB; ": "; varSheetB(iRowB, 4)
            If Trim(varSheetA(iRow, 4)) = Trim(varSheetB(iRowB, 4)) Then
                Found = True
                Exit For
            End If
        Next iRowB
        
        If Found Then 'If the SN is found on the second table
            
            '#######################################################################################################
            'Use
            Call result(iRow, 1, Trim(varSheetA(iRow, 1)) = Trim(varSheetB(iRowB, 1)), _
                                FlexibleUse(varSheetA(iRow, 1)) = FlexibleUse(varSheetB(iRowB, 1)))
            '#######################################################################################################
            'Manufacturer
            Call result(iRow, 2, Trim(varSheetA(iRow, 2)) = Trim(varSheetB(iRowB, 2)), _
                                Flexible(varSheetA(iRow, 2)) = Flexible(varSheetB(iRowB, 2)))
            '#######################################################################################################
            'Model
            Call result(iRow, 3, Trim(varSheetA(iRow, 3)) = Trim(varSheetB(iRowB, 3)), _
                                Flexible(varSheetA(iRow, 3)) = Flexible(varSheetB(iRowB, 3)))
            '#######################################################################################################
            'SN#
            ' If varSheetA(iRow, 4) = varSheetB(iRowB, 4) Then Worksheets("Postgres").Cells(iRow, 4).Interior.ColorIndex = 4
            Call result(iRow, 4, Trim(varSheetA(iRow, 4)) = Trim(varSheetB(iRowB, 4)))
            
            '#######################################################################################################
            'Position /room
            Call result(iRow, 5, InStr(varSheetB(iRowB, 5), ExtractElement(varSheetA(iRow, 5), 1)) > 0 And _
                                 InStr(varSheetB(iRowB, 5), ExtractElement(varSheetA(iRow, 5), 2)) > 0, _
                                 InStr(Flexible(varSheetB(iRowB, 5)), Flexible(ExtractElement(varSheetA(iRow, 5), 1))) > 0 And _
                                 InStr(Flexible(varSheetB(iRowB, 5)), Flexible(ExtractElement(varSheetA(iRow, 5), 2))) > 0)
                                 
            'Debug.Print ExtractElement(varSheetA(iRow, 5), 1); ExtractElement(varSheetA(iRow, 5), 2)
            'Debug.Print varSheetB(iRowB, 5); "¦¦¦¦¦¦"; ExtractElement(varSheetA(iRow, 5), 1); "¦¦¦¦¦¦"; ExtractElement(varSheetA(iRow, 5), 2); "¦¦¦¦¦¦"
            
            '#######################################################################################################
            'Site
            Call result(iRow, 6, InStr(varSheetA(iRow, 6), ExtractElement(varSheetB(iRowB, 6), 1)) > 0)
            
            '#######################################################################################################
            'Hostname
            Call result(iRow, 7, Trim(varSheetA(iRow, 7)) = Trim(varSheetB(iRowB, 7)))
            
            
            '#######################################################################################################
            'IP
            Call result(iRow, 8, Trim(varSheetA(iRow, 8)) = Trim(varSheetB(iRowB, 8)), _
                                InStr(varSheetB(iRowB, 8), ExtractElement(varSheetA(iRow, 8), 1)) > 0)
            
            
            '#######################################################################################################
            'Domain
            Call result(iRow, 9, Trim(varSheetA(iRow, 9)) = Trim(varSheetB(iRowB, 9)), _
                                InStr(FlexibleDomain(varSheetB(iRowB, 9)), FlexibleDomain(ExtractElement(varSheetA(iRow, 9), 1))) > 0)
            
            '#######################################################################################################
            'RAM
             Call result(iRow, 10, Trim(varSheetA(iRow, 10)) = Trim(varSheetB(iRowB, 10)), _
                                FlexibleRAM(varSheetB(iRowB, 10)) = Trim(varSheetA(iRow, 10)) Or _
                                Trim(varSheetB(iRowB, 10)) = FlexibleRAM(varSheetA(iRow, 10)))
            'Debug.Print Trim(varSheetB(iRowB, 10)), FlexibleRAM(varSheetA(iRow, 10))
            '#######################################################################################################
            'Disk
            Call result(iRow, 11, Trim(varSheetA(iRow, 11)) = Trim(varSheetB(iRowB, 11)), _
                                FlexibleRAM(varSheetB(iRowB, 11)) = Trim(varSheetA(iRow, 11)) Or _
                                Trim(varSheetB(iRowB, 11)) = FlexibleRAM(varSheetA(iRow, 11)))
            '#######################################################################################################
            'OS
            Call result(iRow, 12, InStr(varSheetA(iRow, 12), varSheetB(iRowB, 12)) > 0 And _
                                  InStr(varSheetA(iRow, 12), varSheetB(iRowB, 13)) > 0, _
                                    InStr(FlexibleOS(varSheetA(iRow, 12)), FlexibleOS(varSheetB(iRowB, 12))) > 0)
            
            '#######################################################################################################
            'IsVirtual
            Call result(iRow, 14, Trim(varSheetA(iRow, 14)) = Trim(varSheetB(iRowB, 14)), _
                                FlexibleVirtual(varSheetA(iRow, 14)) = FlexibleVirtual(varSheetB(iRowB, 14)))
                                
            '#######################################################################################################
            'Contract
            Call result(iRow, 15, Trim(varSheetA(iRow, 15)) = Trim(varSheetB(iRowB, 15)))
            
            '#######################################################################################################
            
            '#######################################################################################################
                       
            '#######################################################################################################

        End If
    Next iRow

End Sub


'#######################################################################################################
'#######################################################################################################
'#######################################################################################################
'Support functions:
'#######################################################################################################

'Painting the background of the cell
Public Sub result(iRow, iCol, result As Boolean, Optional Flexible As Boolean = False)
    If result Then
        Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 4 'green
    Else
        If Not Flexible Then
            Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 3 'red
        Else
            Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 6 'yellow
        End If
    End If
End Sub

'#######################################################################################################
'Public Function FindFirstInstance(WHAT_TO_FIND As String) As Integer
''Const WHAT_TO_FIND As String = "test2"
'Dim ws As Excel.Worksheet
'Dim FoundCell As Excel.Range '

'Set ws = ActiveSheet
'Set FoundCell = ws.Range("A:A").Find(what:=WHAT_TO_FIND, lookat:=xlWhole)
'If Not FoundCell Is Nothing Then
'    FindFirstInstance = FoundCell.Row
'Else
'    FindFirstInstance = 0
'End If
'End Function


'#######################################################################################################
Function Flexible(ByVal str)
    str = UCase(str)
    str = Replace(str, "D0", "D")
    str = Replace(str, "R0", "R")
    Flexible = str

End Function

'#######################################################################################################
Function FlexibleUse(ByVal str)
    str = UCase(str)
    str = Replace(str, "DEPLOYED", "1")
    str = Replace(str, "DOWN", "2")
    str = Replace(str, "DELETE", "2")
    str = Replace(str, "IN INVENTORY", "2")
    str = Replace(str, "OPERATIVE", "1")
    str = Replace(str, "DEVELOPMENT", "1")
    str = Replace(str, "SPARE ALLOCATED", "2")
    str = Replace(str, "SPARE", "2")

    FlexibleUse = str

End Function


'#######################################################################################################
Function FlexibleDomain(ByVal str)
    str = UCase(str)
    str = Replace(str, "    ", "")
    str = Replace(str, "   ", "")
    str = Replace(str, "  ", "")
    str = Replace(str, " ", "")
    FlexibleDomain = str

End Function

'#######################################################################################################
Function FlexibleRAM(ByVal str)
    str = 1024 * Val(str)
    FlexibleRAM = Trim(str)

End Function

'#######################################################################################################
Function FlexibleOS(ByVal str)
    str = UCase(str)
    str = Replace(str, "LINUX", "")
    str = Replace(str, "    ", "")
    str = Replace(str, "   ", "")
    str = Replace(str, "  ", "")
    str = Replace(str, " ", "")
    FlexibleOS = str

End Function


'#######################################################################################################
Function FlexibleVirtual(ByVal str)
    str = UCase(str)
    str = Replace(str, """PHISICAL_COMPUTER""", "")
    str = Replace(str, "    ", "")
    str = Replace(str, "   ", "")
    str = Replace(str, "  ", "")
    str = Replace(str, " ", "")
    FlexibleVirtual = str

End Function

'#######################################################################################################
Function ExtractElement(ByVal str, ByVal n)
'   Returns the n-th element from a string using different separators

    Dim x As Variant
    
    If Left(str, 3) = "11-" Then
        str = Mid(str, 4)
        'Debug.Print str
    End If
    'str = Replace(str, "11-", "")
    
    str = Replace(str, ";", " ")
    str = Replace(str, "-", " ")
    str = Replace(str, "\n", " ")
    str = Replace(str, "\t", " ")
    str = Replace(str, "     ", " ")
    str = Replace(str, "    ", " ")
    str = Replace(str, "   ", " ")
    str = Replace(str, "  ", " ")
    
    
    str = Trim(str)
    x = Split(str, " ")
    If n > 0 And n - 1 <= UBound(x) Then
       ExtractElement = x(n - 1)
    Else
        ExtractElement = ""
    End If
End Function
'#######################################################################################################