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


  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值