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
vba
猜你喜欢
转载自wentise.iteye.com/blog/1663478
今日推荐
周排行