Marti: Es crea la pàgina amb « Public Sub compareTables() ' For i = 1 To 917 ' str1 = Sheets(1).Cells(i, 1) ' str1b = Trim(Left(str1, InStr(str1, " ") ...».

2013-02-20T18:16:01Z

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, " ") ...».

Pàgina nova

<syntaxhighlight lang="vb">
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
'#######################################################################################################
</syntaxhighlight>

Excel VBA Examples - Historial de revisió

Marti: Es crea la pàgina amb « Public Sub compareTables() ' For i = 1 To 917 ' str1 = Sheets(1).Cells(i, 1) ' str1b = Trim(Left(str1, InStr(str1, " ") ...».