vba
程序员文章站
2022-05-16 09:28:18
...
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
上一篇: vue+VueI18n 项目国际化 笔记
下一篇: java 复制到剪切板