vba


Global Const summitpar_cpty_mapping As String = "summitpar_cpty_mapping"
Global Const trade_mapping_str As String = "trade_mapping"
Global Const cpty_prefix As String = "APO_"
Global Const trade_prefix As String = "_"
Global Const is_key As String = "Y"

Global filed_count As Integer

Global cpty_pos As Integer
Global trade_pos As Integer

Global keyPos() As Integer
Private Sub CommandButton1_Click()
Dim set_sheet
Set set_sheet = Sheets("setting")
Dim prdt_sheet
Set prdt_sheet = Sheets("PRDT")

Dim sit_sheet
Set sit_sheet = Sheets("SIT")

cpty_pos = CInt(set_sheet.Range("B3"))
trade_pos = CInt(set_sheet.Range("B4"))
filed_count = set_sheet.Range("IV1").End(xlToLeft).column - 1
Debug.Print filed_count
'put the key list to keyPos
Call getKey(set_sheet.Name)


Dim sit_sheet_row As Integer
sit_sheet_row = sit_sheet.Range("A65535").End(xlUp).row
Dim prdt_sheet_row As Integer
prdt_sheet_row = prdt_sheet.Range("A65535").End(xlUp).row




Call addWorkSheetCopyVal(sit_sheet.Name)









Call insertBlankKey(getNewTempSheetName(sit_sheet.Name))

'replace the trade_ref start
Dim sit_tradeRange As Range

Set sit_tradeRange = Worksheets(getNewTempSheetName(sit_sheet.Name)).Range("A1:A" + CStr(sit_sheet_row)).Offset(0, trade_pos)
Call setRealTradeRef(sit_tradeRange, trade_mapping_str)

'replace the trade_ref end


Call fillKeys(getNewTempSheetName(sit_sheet.Name), sit_sheet_row, filed_count)
'replace the cpty
Dim sit_cptyRange As Range

Set sit_cptyRange = Worksheets(getNewTempSheetName(sit_sheet.Name)).Range("A1:A" + CStr(sit_sheet_row)).Offset(0, cpty_pos)

Call setRealCpty(sit_cptyRange, summitpar_cpty_mapping)

Call addWorkSheetCopyVal(prdt_sheet.Name)
Call insertBlankKey(getNewTempSheetName(prdt_sheet.Name))
Call fillKeys(getNewTempSheetName(prdt_sheet.Name), prdt_sheet_row, filed_count)

Call compareResult(set_sheet.Name, sit_sheet.Name, sit_sheet_row, prdt_sheet.Name, prdt_sheet_row)

End Sub
Public Function compareResult(ByVal setting_sheet As String, ByVal sit_sheet_new As String, ByVal sit_sheet_row, ByVal prdt_sheet_new As String, ByVal prdt_sheet_row)
Dim mysitSheet As Worksheet
Set mysitSheet = Worksheets(getNewTempSheetName(sit_sheet_new))
Dim myprdtSheet As Worksheet
Set myprdtSheet = Worksheets(getNewTempSheetName(prdt_sheet_new))
Dim mysetting_sheet As Worksheet
Set mysetting_sheet = Worksheets(setting_sheet)



Dim result_row As Integer
result_row = 2
Dim result_column As Integer
result_column = 1

Call addWorkSheet("compare_result")
Dim myresultSheet As Worksheet
Set myresultSheet = Worksheets("compare_result")

Dim title_col As Integer
title_col = 2
For Each fieldRange In mysetting_sheet.Range(mysetting_sheet.Cells(1, 2), mysetting_sheet.Cells(1, filed_count + 1))
myresultSheet.Cells(1, title_col).Value = CStr(fieldRange.Value) + "_prdt"
title_col = title_col + 1
myresultSheet.Cells(1, title_col).Value = CStr(fieldRange.Value) + "_sit"
title_col = title_col + 1
myresultSheet.Cells(1, title_col).Value = CStr(fieldRange.Value) + "_diff"
title_col = title_col + 1
Next


Dim prdtRangeStr As String
prdtRangeStr = "A1:A" + CStr(prdt_sheet_row)
For Each prdtRange In myprdtSheet.Range(prdtRangeStr)
'set the prdt key first
myresultSheet.Cells(result_row, result_column) = CStr(prdtRange.Value)
Call Worksheet_CellsChange(prdtRange, 60)
Dim getSitRange As Range


 For Each sitRange In mysitSheet.Range("A1:A" + CStr(sit_sheet_row))
    If CStr(sitRange.Value) = CStr(prdtRange.Value) Then
      Set getSitRange = sitRange
      Call Worksheet_CellsChange(sitRange, 150)
     Exit For
     Else
     'sitRange.Next
     Set getSitRange = myresultSheet.Range("A1:A1")
      
    End If
 Next
'getSitRange = getKeyByKey(mysitSheet, sit_sheet_row, CStr(prdtRange.Value))
 
    For i = 1 To filed_count
    Dim compare1, compare2 As String
    compare1 = ""
    compare2 = ""
     result_column = result_column + 1
     compare1 = prdtRange.Offset(0, i).Value
     myresultSheet.Cells(result_row, result_column) = prdtRange.Offset(0, i).Value
     result_column = result_column + 1
     If getSitRange <> Empty Then
          compare2 = getSitRange.Offset(0, i).Value
          myresultSheet.Cells(result_row, result_column) = getSitRange.Offset(0, i).Value
          
          
          
     End If
     result_column = result_column + 1
     If compare1 = compare2 Then
     myresultSheet.Cells(result_row, result_column) = "same"
     Else
      myresultSheet.Cells(result_row, result_column) = "diff"
     End If
    Next

result_row = result_row + 1
result_column = 1
Next

End Function


'Public Function getKeyByKey(ByVal mysitSheet As Worksheet, ByVal sit_sheet_row As Integer, ByVal prdtRangeVal As String)

 'For Each sitRange In Worksheets("SIT_new").Range("A1:A" + CStr(sit_sheet_row))
 
 '   If CStr(sitRange.Value) = prdtRangeVal Then
 '      getKeyByKey = sitRange
     ' Call Worksheet_CellsChange(sitRange, 150)
 '    Exit For
 '   End If
' Next
 'getKeyByKey = Empty
 
' Debug.Print getKeyByKey
'End Function


    Private Sub Worksheet_CellsChange(ByVal Target As Range, ByVal color As Integer)
    On Error Resume Next

    With Target.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    End Sub
    

Public Function insertBlankKey(ByVal sheetname As String)
Dim mysheet As Worksheet

Set mysheet = Worksheets(sheetname)
mysheet.Select
ActiveSheet.Columns("A").Insert

End Function

Public Function fillKeys(ByVal sheetname As String, ByVal row As Integer, ByVal column As Integer)
Dim mysheet As Worksheet
Dim keyStr As String
Dim rangStr As String
Set mysheet = Worksheets(sheetname)
For i = 1 To row

mysheet.Cells(i, 1) = getKeyStr(mysheet, i)

Next
End Function

Public Function getKeyStr(ByRef mysheet As Worksheet, ByVal row As Integer)
getKeyStr = ""
 For i = 0 To UBound(keyPos)
 Debug.Print keyPos(i)

 mykey = mysheet.Cells(row, keyPos(i) + 1)
 Debug.Print mykey
getKeyStr = getKeyStr + mykey + "_"

 Next
 
End Function



Public Function setRealTradeRef(ByRef myRan As Range, ByVal sheetname As String)
For Each mycell In myRan.Cells
mycell.Value = getRealTradeRef(CStr(mycell.Value), sheetname)
Next
 
End Function

Public Function getRealTradeRef(ByVal tradeRef As String, ByVal sheetname As String)
'Dim myPos As Integer
'myPos = InStr(tradeRef, trade_prefix)
'If myPos > 0 Then
'tradeRef = Replace(tradeRef, Mid(Trade_ref, 1, myPos), "")
tradeRef = trimPrefix(tradeRef, "")
Dim trade_map As Worksheet
Dim trade_map_row As Integer
getRealTradeRef = tradeRef
Set trade_map = Worksheets(sheetname)
trade_map_row = trade_map.Range("A65535").End(xlUp).row
Dim trade_Range As Range
Set trade_Range = trade_map.Range("A1:A" + CStr(trade_map_row))

For Each myRange In trade_Range
 If CStr(myRange.Value) = tradeRef Then
 getRealTradeRef = trimPrefix(CStr(myRange.Offset(0, 1).Value), "")
 Exit For
 End If
Next
 Debug.Print getRealTradeRef
End Function


Public Function trimPrefix(ByVal tradeRef As String, ByVal prefix As String)
Dim myPos As Integer
myPos = InStr(tradeRef, trade_prefix)
If myPos > 0 Then
tradeRef = Replace(tradeRef, Mid(trade_ref, 1, myPos), "")
End If

trimPrefix = tradeRef
End Function

Public Function getRealCpty(ByVal Cpty As String, ByVal sheetname As String)
Cpty = Replace(Cpty, cpty_prefix, "")
Dim cpty_map As Worksheet
Dim cpty_map_row As Integer
getRealCpty = Cpty
Set cpty_map = Worksheets(sheetname)
cpty_map_row = cpty_map.Range("A65535").End(xlUp).row
Dim cptyRange As Range
Set cptyRange = cpty_map.Range("A1:A" + CStr(cpty_map_row))

For Each myRange In cptyRange
 If Replace(CStr(myRange.Value), cpty_prefix, "") = Cpty Then
 getRealCpty = CStr(myRange.Offset(0, 1).Value)
 Exit For
 End If
Next
 Debug.Print getRealCpty
 
End Function

Public Function setRealCpty(ByRef Range As Range, ByVal sheetname As String)
For Each mycell In Range.Cells
mycell.Value = getRealCpty(CStr(mycell.Value), sheetname)
Next
 
End Function

Public Function getKey(ByVal set_sheet As String)
 ReDim Preserve keyPos(filed_count)
 Dim count As Integer
 count = 0
 For i = 1 To filed_count + 1

 If Worksheets(set_sheet).Cells(2, i) = is_key Then
 Debug.Print Worksheets(set_sheet).Cells(2, i)
 keyPos(count) = i - 1
 count = count + 1
 End If
 Next
 ReDim Preserve keyPos(count - 1)
End Function




Public Function getNewTempSheetName(ByVal temp_sheet As String)
Dim temp_sheet_new As String
temp_sheet_new = temp_sheet + "_new"
getNewTempSheetName = temp_sheet_new
End Function

Public Function addWorkSheetCopyVal(ByVal temp_sheet As String)
Dim temp_sheet_new As String
temp_sheet_new = getNewTempSheetName(temp_sheet)
deleteSheet (temp_sheet_new)

Dim sh As Worksheet
Set sh = Sheets.Add
With sh
.Name = temp_sheet_new
End With

 Call copySheet(temp_sheet, temp_sheet_new)
 
 
End Function

Public Function addWorkSheet(ByVal temp_sheet As String)

deleteSheet (temp_sheet)

Dim sh As Worksheet
Set sh = Sheets.Add
With sh
.Name = temp_sheet
End With

 
End Function

Public Function deleteSheet(ByVal temp_sheet_new As String)
On Error GoTo back
Set ws = Worksheets(temp_sheet_new)
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
back:
Debug.Print "the sheet" + temp_sheet_new + "not exit."
End Function

Public Sub copySheet(ByVal temp_sheet As String, ByVal temp_sheet_new As String)
 Worksheets(temp_sheet).UsedRange.Copy
 Worksheets(temp_sheet_new).Paste
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub




猜你喜欢

转载自wentise.iteye.com/blog/1663478
vba