`
wentise
  • 浏览: 23227 次
  • 性别: Icon_minigender_2
  • 来自: 北京
社区版块
存档分类
最新评论

vba

    博客分类:
  • vba
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




分享到:
评论

相关推荐

    AutoCAD-VBA命令大全.zip_AutoCAD_VBA_CAD VBA 命令_VBa_autocad vba_cad命

    AutoCAD VBA(Visual Basic for Applications)是一种强大的编程工具,专为AutoCAD用户设计,用于扩展和自动化CAD软件的功能。这个“AutoCAD-VBA命令大全.zip”文件包含了一个名为“AutoCAD-VBA命令大全.doc”的文档...

    二维码小工具 -VBA_二维码vba_二维码_二维码生成_VBa_VBA二维码_

    二维码小工具 - VBA_二维码vba_二维码_二维码生成_VBa_VBA二维码是一个使用VBA(Visual Basic for Applications)编程实现的Excel宏工具,它允许用户在Excel环境中生成二维码。VBA是Microsoft Office套件中内置的一...

    WPS支持VBA 7.1版本 VBA For WPS 2019(1)插件,大家打开vba组件所需

    本文将深入探讨WPS Office对于VBA(Visual Basic for Applications)的支持,特别是关于VBA 7.1版本及其相关的插件,以帮助用户更好地理解和利用这一功能。 VBA是Microsoft Office中内置的一种编程语言,允许用户...

    VBA代码助手专业版_VBa_VBA代码助手_

    VBA(Visual Basic for Applications)是Microsoft Office套件中内置的一种编程语言,它允许用户自定义各种应用程序的功能,包括Excel、Word、PowerPoint等。VBA代码助手专业版是一款专门针对VBA编程的辅助工具,...

    WPS支持VBA 7.1版本 VBA For WPS

    VBA(Visual Basic for Applications)是一种在Microsoft Office套件中广泛使用的编程语言,允许用户自定义功能、创建宏和自动化工作流程。WPS Office,作为Microsoft Office的替代品,也开始支持VBA,尤其是VBA 7.1...

    进销存管理系统(Excel VBA实现)_ExcelVBA_VBa_进销存_vba进销存管理_VBA进销存

    在Excel中结合VBA(Visual Basic for Applications)实现进销存管理,可以提供一种便捷且自定义化的解决方案,尤其适合中小企业或个人使用。下面将详细介绍这种系统的基本构成和关键功能,以及VBA在其中的应用。 ...

    CAD VBA开发人员手册(原)

    ### CAD VBA开发人员手册(原) #### 第1章 VBA入门 **1.1 了解嵌入和全局VBA工程** 在AutoCAD VBA环境中,工程是指一系列代码模块、类模块以及窗体的集合,这些集合在一起实现特定功能。根据存储位置的不同,...

    VBA manual(微软官方VBA手册)

    VBA手册是微软官方提供的关于Visual Basic for Applications(VBA)编程语言的指南,它主要面向使用MS Office 2010或MS Excel VBA进行自动化任务和创建宏的用户。VBA是为Office套件量身打造的编程语言,用于控制文档...

    最新版VBA插件7.1支持wps

    VBA(Visual Basic for Applications)是一种在Microsoft Office套件中广泛使用的编程语言,它允许用户自定义工作流程、创建宏和编写复杂的自动化脚本。VBA插件则是扩展这种功能的工具,通常由第三方开发者创建,以...

    【免费下载】ExcelVBA和WordVBA教程.rar

    VBA(Visual Basic for Applications)是Microsoft Office套件中内置的一种编程语言,它允许用户自定义功能、自动化任务,极大地提升了工作效率。本教程主要聚焦于Excel VBA和Word VBA,这两个工具在日常办公中有着...

    Excel VBA视频教程 80集

    第001集:宏与VBA 第002集:VBA中的语句、对象、方法与属性 第003集:循环语句 第004集:判断语句 第005集:VBA变量 第006集:函数与公式 第007集: VBE编辑器 第008集:VBA分支与End语句 第009集: excel文件操作 第010集:...

    AutoCAD VBA开发手册,cadvba教程,Visual Basic

    AutoCAD VBA开发手册是一本专门针对CAD二次开发的教程,主要聚焦于使用Visual Basic for Applications(VBA)这一编程工具。VBA是Microsoft Office套件中的一个强大工具,也被集成在AutoCAD中,允许用户自定义CAD...

    VBA 7.1 FOR WPS 2019

    VBA(Visual Basic for Applications)是Microsoft Office套件中用于自动化和自定义应用程序的强大编程语言。在WPS Office 2019中,虽然它不是一个默认功能,但用户可以通过安装额外的模块来启用VBA支持。标题“VBA ...

    VBA解析outlook邮件

    VBA解析Outlook邮件 通过Outlook自带的VBA宏解析Outlook邮件,提取邮件的主题、抄送、正文等信息,我们可以使用VBA宏来自动化处理邮件信息。下面是相关知识点的详细解释: 1. VBA宏: VBA(Visual Basic for ...

    VBA代码助手专业版3.7.8.0

    VBA代码库收藏管理, VBA中文代码库输入提示, VBA变量名首字母输入提示 VBA函数过程输入提示, VBA代码自动对齐排版, VBA代码混淆, VBA工程密码破解, Excel VBA模块隐藏保护, VBA颜色修改器, VBA代码行号显示 ...

    WPSVBA、ExcelVBA编程实例(150例).zip

    《WPSVBA与ExcelVBA编程实例(150例)》是一个综合性的学习资源,旨在帮助用户深入了解和掌握WPS表格与Excel中的VBA(Visual Basic for Applications)编程技术。VBA是一种强大的编程语言,它允许用户自定义工作簿、...

    兰色幻想VBA80集第6集:函数与公式.zip_frozenlmd_vba完整_兰色幻想 80_兰色幻想vba从入门到进阶80集

    《兰色幻想VBA80集》是一部针对初学者到进阶者的VBA(Visual Basic for Applications)学习教程,旨在帮助用户深入理解并掌握Excel、Word等Microsoft Office套件中的编程技能。本教程的第6集重点讲解了“函数与公式...

    Office VBA 2013 CHM

    《Office VBA 2013 CHM》是针对VBA(Visual Basic for Applications)编程在Office 2013套件中的全面指南。VBA是Microsoft Office中内置的一种编程语言,允许用户自定义功能,自动化任务,以及创建宏来提高工作效率...

    [VBA]《ActiveX 和 VBA 参考》由明经通道翻译_cadvba_明经cad通道

    标题中的“[VBA]《ActiveX 和 VBA 参考》由明经通道翻译_cadvba_明经cad通道”表明这是一份关于VBA(Visual Basic for Applications)和ActiveX技术的参考文档,由“明经通道”翻译。ActiveX是微软开发的一种技术,...

    WPS VBA宏使用权限

    在IT行业中,VBA(Visual Basic for Applications)是一种强大的编程语言,主要用于自动化和扩展Microsoft Office应用程序的功能。在WPS Office中,VBA同样被用来创建宏,实现文档处理的自动化和自定义功能。本篇...

Global site tag (gtag.js) - Google Analytics