精品91一区二区三区,人女久久久,中文有码亚洲人妻

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

'----------------------------------------當發(fā)生錯誤時--------------------------------------------

On Error Resume Next '發(fā)生錯誤時 讓程序繼續(xù)執(zhí)行下一句代碼


Set TarWb = Workbooks.Open(TarFile) '打開剛才選擇的那個文件

On Error Resume Next '發(fā)生錯誤時 讓程序繼續(xù)執(zhí)行下一句代碼


TarTab = Application.InputBox(prompt:="Please input the name of your target table here" _
& " ", Title:="DATA SELECTION", Type:=2) 'application.inputbox在輸入字符串后點擊“確認”按鈕根據(jù)type類型返回不同點擊“取消”則返回邏輯type為 0 返回文本，type為1返回數(shù)字 type為2返回公式  ，4 邏輯值 8單元格引用 16錯誤值值false類型的值

If TarWb.Worksheets(TarTab) Is Nothing Then '如果輸入的table無內容，則執(zhí)行下面代碼塊

   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 行號 向上數(shù)簡單理解A列最后一個有數(shù)據(jù)的單元所在的行數(shù)

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 '如果這個區(qū)域是空的進行里面這個代碼塊

   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-擦除去老數(shù)據(jù)--------------------------------------------------------------

Application.ScreenUpdating = False '如果屏幕更新已啟用，此屬性的值為 True
'關閉屏幕更新可加快宏的執(zhí)行速度。這樣將看不到宏的執(zhí)行過程，但宏的執(zhí)行速度加快了。
'當宏結束運行后，請記住將 ScreenUpdating 屬性設置回 True。
Application.Calculation = xlCalculationManual 'calculation是指手動計算還是自動計算。
'處理大數(shù)據(jù)量時，為了更快的運行，VBA通常在開始加兩句即上兩句話是常用的模版處理，有開始有關閉一定要成對出現(xiàn)


yRow = Revenue.Range("A20000").End(xlUp).Row

Revenue.Range("A2:AB" & yRow + 2).ClearContents '清理區(qū)域中的公式和值。

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)
    '調整指定區(qū)域的大小。 返回一個 Range 對象，它表示已重設大小的區(qū)域。調整大小(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的行和列的數(shù)值賦值給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已經(jīng)代表目標的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)
    '這里就是測量一下你的筐里的蘋果的長（行數(shù)）和寬（列數(shù)）然后我把我的筐子也改造這么大，就能裝下你的蘋果了

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表示返回四舍五入到指定小數(shù)位數(shù)的數(shù)
'$J$5加了兩個$符號可以確保公式復制到其他單元格時，還是$J$5（所謂[絕對引用]

DSO.Range("I" & i).Value = "=IF(ISERROR(VLOOKUP($C" & i & ",EATP!A:A,1,0)),""N"",""Y"")"

'=VLOOKUP(查找值,查找區(qū)域,返回查找區(qū)域第N列,查找模式)0精確，1模糊，iseror返回 TRUE 或 FALSE
‘這個公式的含義是：匹配C列的值再EATP 的A列存不存在，存在顯示N，不存在顯示Y
‘ excel中COUNTA(標簽！A:A)（標簽！A:A)   統(tǒng)計標簽表中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"

'上面是一些常規(guī)屬性，具體我一個個給你翻譯[詳情]([https://docs.microsoft.com/zh-cn/office/vba/api/excel.protection.allowdeletingcolumns](https://docs.microsoft.com/zh-cn/office/vba/api/excel.protection.allowdeletingcolumns)
)
‘a(chǎn)ctivesheet.protect -- 保護[工作表]
’drawingobjects=true，contents=true,scenarios=true -- 默認選項，保護表格對象、內容、和不定的內容（如公式）
‘AllowFormattingCells:=True如果允許對受保護的工作表上的單元格設置格式,則返回 True 
‘AllowFormattingColumns:=True如果在受保護的工作表上允許列的格式，則，返回True
‘AllowFormattingRows:=True允許用戶對受保護的工作表上的行進行格式設置
‘AllowInsertingRows:=True允許用戶在受保護的工作表上插入列
‘ AllowDeletingRows允許刪除受保護的工作表上的行, 則返回True
’ AllowSorting允許在受保護的工作表上使用排序
‘AllowFiltering允許用戶使用在工作表受保護之前創(chuàng)建的自動篩選器

MsgBox "Done ! data is mapping sucessfully."

End Sub
色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九欧美,1769亚洲,黄色成人av

一個宏文件vba

一個宏文件vba

友情鏈接更多精彩內容

色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九 欧美,1769亚洲,黄色成人av

一個宏文件vba

友情鏈接更多精彩內容

色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九欧美,1769亚洲,黄色成人av
