Sub Revenue_LOAD()
'
' DSO_Revenue 宏
'
Msg = MsgBox("LOAD Revenue" & vbNewLine & vbNewLine & "This process will guide you to load Revenue provided by BI" _
& vbNewLine & "this tool step by step, and current Revenue will be erased completely." & vbNewLine & vbNewLine & "Do you want to continue?" & vbNewLine _
& vbNewLine & "-------------------------------------------------------------------------" _
& vbNewLine _
& vbNewLine & "Step 1: Choose the file contains Revenue from window popped up;" _
& vbNewLine & "Step 2: Input the target table name which contains Revenue into dialog" _
& vbNewLine & " box popped up;" _
& vbNewLine & "Step 3: Please check the accuracy of Revenue loaded." _
, vbYesNo, "WARNING")
If Msg = vbNo Then '否按钮被单击
ThisWorkbook.Worksheets("From Pact V1").Activate
Exit Sub
End If
'---------------------------------------------------------------Define Variable---------------------------------------------------------------
Dim xRow As Long
Dim yRow As Long
Dim TarFile, TarTab As String
Dim TarWb As Workbook
Dim tarRange, myRange As Range
Dim DSO As Worksheet
Set Revenue = ThisWorkbook.Worksheets("From Pact V1")
'---------------------------------------------------------------Open DSO Source---------------------------------------------------------------
TarFile = Application.GetOpenFilename 'GetOpenFilename相当于Excel打开窗口，通过该窗口选择要打开的文件，并可以返回选择的文件完整路径和文件名
MsgBox "Revenue path: " & TarFile
If TarFile = "False" Then '如果点击了取消，返回false
Revenue.Activate
Exit Sub
End If
'----------------------------------------当发生错误时--------------------------------------------
On Error Resume Next '发生错误时 让程序继续执行下一句代码
Set TarWb = Workbooks.Open(TarFile) '打开刚才选择的那个文件
On Error Resume Next '发生错误时 让程序继续执行下一句代码
TarTab = Application.InputBox(prompt:="Please input the name of your target table here" _
& " ", Title:="DATA SELECTION", Type:=2) 'application.inputbox在输入字符串后点击“确认”按钮根据type类型返回不同点击“取消”则返回逻辑type为 0 返回文本，type为1返回数字 type为2返回公式 ，4 逻辑值 8单元格引用 16错误值值false类型的值
If TarWb.Worksheets(TarTab) Is Nothing Then '如果输入的table无内容，则执行下面代码块
MsgBox "Please input a valid worksheet name! for example 'Sheet1'"""
DSO.Activate '使这个表为当前活跃的工作表，相当于鼠标点击选择了此表
TarWb.Close SaveChanges:=False '关闭不保存
Exit Sub
End If
'------------------------------------------探空如果有值就赋值对应给xRow和tarRange------------------------------------------
On Error Resume Next
xRow = TarWb.Worksheets(TarTab).Range("A20000").End(xlUp).Row
'把上一步手动输入的那个表end(xlup)向上非空单元格 .row 行号 向上数简单理解A列最后一个有数据的单元所在的行数
MsgBox "Count of SubData line is going to be loaded >>> " & xRow & ""
Set tarRange = TarWb.Worksheets(TarTab).Range("A2:C" & xRow) ' "c"的第xRow列如A2:C12435
If tarRange Is Nothing Then '如果这个区域是空的进行里面这个代码块
Revenue.Activate
TarWb.Close SaveChanges:=False
Exit Sub
End If
'---------------------------------------------------------------Show All Data---------------------------------------------------------------
On Error Resume Next
Revenue.Unprotect Password:="XXXXXX" 'Excel 表格密护的方法
Revenue.ShowAllData '使当前筛选列表的所有行均可见
'---------------------------------------------------------------Erase Old Data-擦除去老数据--------------------------------------------------------------
Application.ScreenUpdating = False '如果屏幕更新已启用，此属性的值为 True
'关闭屏幕更新可加快宏的执行速度。这样将看不到宏的执行过程，但宏的执行速度加快了。
'当宏结束运行后，请记住将 ScreenUpdating 属性设置回 True。
Application.Calculation = xlCalculationManual 'calculation是指手动计算还是自动计算。
'处理大数据量时，为了更快的运行，VBA通常在开始加两句即上两句话是常用的模版处理，有开始有关闭一定要成对出现
yRow = Revenue.Range("A20000").End(xlUp).Row
Revenue.Range("A2:AB" & yRow + 2).ClearContents '清理区域中的公式和值。
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'对应上面开始
'---------------------------------------------------------------Copy DSO 1-3 to DSO Tool---------------------------------------------------------------
Set myRange = ThisWorkbook.Worksheets("From Pact V1").Range("A2")
'with的作用就是简化代码，让代码简洁易懂
'让你不需要输入重复的内容也就是说with中以 . 开头的就相当这里的tarRange.
With tarRange
Set myRange = myRange.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
'调整指定区域的大小。 返回一个 Range 对象，它表示已重设大小的区域。调整大小(RowSize, ColumnSize)
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'以上两句又是套路，代表要大量运算，怕机器受不了所以写这一对上去注意闭合
myRange.Value = tarRange.Value
'这句话就是最简单的把你框里的苹果放我框
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'以上两句代表闭合，过河一定记得拆桥
Set tarRange = Nothing
Set myRange = Nothing
'就是要释放对象变量所占的内存空间需要set nothing最好加上这句，主要是怕机器太累，你俩换完苹果了，主动把筐子弄干净留给别人用
'------------------------------------------------------------------------------------
On Error Resume Next
Set tarRange = TarWb.Worksheets(TarTab).Range("E2:E" & xRow)
'就是选择E2到E结尾赋值给tarRange
If tarRange Is Nothing Then
Revenue.Activate
TarWb.Close SaveChanges:=False
Exit Sub
End If
'---------------------------------------------------------------Copy DSO 4 to DSO Tool---------------------------------------------------------------
Set myRange = ThisWorkbook.Worksheets("From Pact V1").Range("D2")
'选择了From Pact V1这个sheet的D2列
With tarRange
Set myRange = myRange.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
'把刚才那个DSO选中的tarRange的行和列的数值赋值给myRange
End With
'不说了，下面开始交换苹果了
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myRange.Value = tarRange.Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set tarRange = Nothing
Set myRange = Nothing
'------------------------------------------------------------------------------------
On Error Resume Next
Set tarRange = TarWb.Worksheets(TarTab).Range("S2:S" & xRow)
'跟上面一样这次选择TarTab的S2到结尾
If tarRange Is Nothing Then
Revenue.Activate
TarWb.Close SaveChanges:=False
'跟上面一样，就是用完了不保存直接退出
'看到这里就看出来套路了吧这里的tarRange已经代表目标的S2列了下面还是如此炮制
'猜的出来下面的步骤就要把这个选择好的目标列交给另外一个myRange，也就是交换苹果
Exit Sub
End If
'---------------------------------------------------------------Copy DSO 5 to DSO Tool---------------------------------------------------------------
Set myRange = ThisWorkbook.Worksheets("From Pact V1").Range("E2")
'定义上面就是定义新的myRange，这个就相当于我手里的筐，我筐里装的E2这个列
With tarRange
Set myRange = myRange.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
'这里就是测量一下你的筐里的苹果的长（行数）和宽（列数）然后我把我的筐子也改造这么大，就能装下你的苹果了
End With
'下面就是套路了，我们都准备好了，那么换苹果吧
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myRange.Value = tarRange.Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set tarRange = Nothing
Set myRange = Nothing
'-------------------------------------换完苹果又该重新准备新的tarRange了-----------------------------------------------
On Error Resume Next
Set tarRange = TarWb.Worksheets(TarTab).Range("U2:U" & xRow)
If tarRange Is Nothing Then
Revenue.Activate
TarWb.Close SaveChanges:=False
Exit Sub
End If
'---------------------------------------------------------------Copy DSO 6 to DSO Tool--定义我的筐然后实施交换-------------------------------------------------------------
Set myRange = ThisWorkbook.Worksheets("From Pact V1").Range("F2")
With tarRange
Set myRange = myRange.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myRange.Value = tarRange.Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set tarRange = Nothing
Set myRange = Nothing
'--------------------------------------做完交换后再定义下一个目标----------------------------------------------
On Error Resume Next
Set tarRange = TarWb.Worksheets(TarTab).Range("V2:V" & xRow)
If tarRange Is Nothing Then
Revenue.Activate
TarWb.Close SaveChanges:=False
Exit Sub
End If
'--------------------------------------------------不想说了-------------Copy DSO 5 to DSO Tool---------------------------------------------------------------
Set myRange = ThisWorkbook.Worksheets("From Pact V1").Range("G2")
With tarRange
Set myRange = myRange.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myRange.Value = tarRange.Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set tarRange = Nothing
Set myRange = Nothing
TarWb.Close SaveChanges:=False
Revenue.Activate
MsgBox "Done ! SubData is loaded sucessfully." _
& vbNewLine & vbNewLine & "Next step, the program will map up supplymentary information for you."
'还的说两句，交换都成功了，然后打出上面这句英文，显得逼格高
'---------------------------------------------------------------Data Mapping- 映射，绘制地图的意思？？？？--------------------------------------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 2 To xRow
DSO.Range("H" & i).Value = "=ROUND($F" & i & "-$G" & i & ",2)"
'对DSO的H列第i行单元格的值赋值，Round表示返回四舍五入到指定小数位数的数
'$J$5加了两个$符号可以确保公式复制到其他单元格时，还是$J$5（所谓[绝对引用]
DSO.Range("I" & i).Value = "=IF(ISERROR(VLOOKUP($C" & i & ",EATP!A:A,1,0)),""N"",""Y"")"
'=VLOOKUP(查找值,查找区域,返回查找区域第N列,查找模式)0精确，1模糊，iseror返回 TRUE 或 FALSE
‘这个公式的含义是：匹配C列的值再EATP 的A列存不存在，存在显示N，不存在显示Y
‘ excel中COUNTA(标签！A:A)（标签！A:A) 统计标签表中A列一共有多少个非空的单元格。
DSO.Range("J" & i).Value = "=IF(ISERROR(VLOOKUP($C" & i & ",'TAX FREE'!A:A,1,0)),""N"",""Y"")"
’如上一个公式
DSO.Range("L" & i).Value = "=IF($K" & i & "=0,0,IF($K" & i & "=1,MIN($F" & i & ",$H" & i & "),IF($K" & i & "=2,$F" & i & ",""输入金额"")))"
DSO.Range("M" & i).Value = "=ROUND($F" & i & "-$L" & i & ",2)"
DSO.Range("N" & i).Value = "=VLOOKUP($E" & i & ",'Exch Rate'!$A:$D,4,0)*'Unbilled AR Report'!F" & i & "/'Exch Rate'!$D$2"
DSO.Range("O" & i).Value = "=VLOOKUP($E" & i & ",'Exch Rate'!$A:$D,4,0)*'Unbilled AR Report'!H" & i & "/'Exch Rate'!$D$2"
DSO.Range("P" & i).Value = "=VLOOKUP($E" & i & ",'Exch Rate'!$A:$D,4,0)*'Unbilled AR Report'!L" & i & "/'Exch Rate'!$D$2"
DSO.Range("Q" & i).Value = "=VLOOKUP($E" & i & ",'Exch Rate'!$A:$D,4,0)*'Unbilled AR Report'!M" & i & "/'Exch Rate'!$D$2"
DSO.Range("S" & i).Value = "=$A" & i & ""
DSO.Range("T" & i).Value = "=VLOOKUP($S" & i & ",'LE List'!$B:$C,2,0)"
DSO.Range("U" & i).Value = "=VLOOKUP($B" & i & ",'LE List'!$A:$C,2,0)"
DSO.Range("R" & i).Value = "=$S" & i & "&$U" & i & ""
DSO.Range("V" & i).Value = "=VLOOKUP($B" & i & ",'LE List'!$A:$C,3,0)"
DSO.Range("W" & i).Value = "=VLOOKUP($T" & i & ",'LE List'!$C:$D,2,0)"
DSO.Range("X" & i).Value = "=VLOOKUP($U" & i & ",'LE List'!$B:$D,3,0)"
DSO.Range("Y" & i).Value = "=$C" & i & ""
DSO.Range("Z" & i).Value = "=$D" & i & ""
DSO.Range("AA" & i).Value = "=$L" & i & ""
DSO.Range("AB" & i).Value = "=IF($J" & i & "=""N"",IF(OR($A" & i & "=37,$A" & i & "=31,$A" & i & "=1002),IF(OR(LEFT($Y" & i & ",2)=""UW"",LEFT($Y" & i & ",2)=""VT""),""免税"",""非免税""),""非免税""),""免税"")"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
DSO.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:= _
True, AllowSorting:=True, AllowFiltering:=True, Password:="XXXXXX"
'上面是一些常规属性，具体我一个个给你翻译[详情]([https://docs.microsoft.com/zh-cn/office/vba/api/excel.protection.allowdeletingcolumns](https://docs.microsoft.com/zh-cn/office/vba/api/excel.protection.allowdeletingcolumns)
)
‘activesheet.protect -- 保护[工作表]
’drawingobjects=true，contents=true,scenarios=true -- 默认选项，保护表格对象、内容、和不定的内容（如公式）
‘AllowFormattingCells:=True如果允许对受保护的工作表上的单元格设置格式,则返回 True
‘AllowFormattingColumns:=True如果在受保护的工作表上允许列的格式，则，返回True
‘AllowFormattingRows:=True允许用户对受保护的工作表上的行进行格式设置
‘AllowInsertingRows:=True允许用户在受保护的工作表上插入列
‘ AllowDeletingRows允许删除受保护的工作表上的行, 则返回True
’ AllowSorting允许在受保护的工作表上使用排序
‘AllowFiltering允许用户使用在工作表受保护之前创建的自动筛选器
MsgBox "Done ! data is mapping sucessfully."
End Sub
