通補合計程序

原創 90后逆袭 2020-02-24 12:10 
Private Sub LetDo_Click()
    Dim name, FilesName, pname As String
    '設置刪選
    
    Dim iloc, Position As String
    Do
        Position = iloc '取得當前檢測到的目標字符的位置
        iloc = InStr(iloc + 1, FilePath1, "\") '測試目標字符在這個字符串中有沒有下個位置，如果沒有就退出
    Loop Until iloc = 0
    FilesName = Right(FilePath1, Len(FilePath1) - Position) '取得文件名稱
    
    On Error Resume Next
    If StrComp(Workbooks(FilesName).name, FilesName, 1) <> 0 Then
        Workbooks.Open (FilePath1) '打開文件
    End If
    Windows(FilesName).Activate
    
    '檢查有所有sheet有沒有符合要求
    Dim Ws As Worksheet
    Dim BName As String
    Dim ExitSheets As Boolean
    ExitSheets = True
    On Error Resume Next
    BName = "通補合計"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "收入"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "匯款"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
     BName = "網絡開發"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "單店產出"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    
    '進入主處理程序
    If ExitSheets = True Then
        '取消各個sheet的vlookup
    '取消“通補合計”裏的vlookup
        Sheets("通補合計").Select
        Range("C3:G60").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     '取消“收入”裏的vlookup
        Sheets("收入").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
    '取消“回款”裏的vlookup
        Sheets("回款").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        
    '取消“網絡開發”裏的vlookup
        Sheets("網絡開發").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
    '取消“單店產出”裏的vlookup
        Sheets("單店產出").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
        Sheets("sheet1").Select
        Cells.Select
        Selection.Delete
        
        Sheets("收入").Select
        
            Rows("2:5").Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("2:5").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("8:11").Select
            ActiveSheet.Paste
            
        Sheets("網絡開發").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("16:19").Select
            ActiveSheet.Paste
            
        Sheets("單店產出").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("24:27").Select
            ActiveSheet.Paste
            
             
        Dim i As Long
        Dim fgsname, sheetname As String
        For i = 6 To 39
            
        Sheets("收入").Select
        
            fgsname = Range("B" & i).Value
            Rows(i & ":" & i).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("6:6").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("12:12").Select
            ActiveSheet.Paste
        
            
        Sheets("網絡開發").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("20:20").Select
            ActiveSheet.Paste
            
        Sheets("單店產出").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("28:28").Select
            ActiveSheet.Paste
        
           
            Cells.Select
            Selection.Copy
            Workbooks.Add
            Cells.Select
            ActiveSheet.Paste
            Application.DisplayAlerts = False
               ActiveWorkbook.SaveAs FileName:=FilePath2 & fgsname & "2014年上半年產品總考覈得分.xls", _
                FileFormat:=xlExcel8, WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            sheetname = fgsname & "2014年上半年產品總考覈得分.xls"
            Windows(FilesName).Activate
            Sheets(Array("通補合計")).Select
            Application.CutCopyMode = False
            
            Sheets("通補合計").Select
            Cells.Select
            Selection.Copy
            Workbooks(sheetname).Activate
            
            Sheets.Add After:=ActiveSheet
            Sheets("Sheet2").Select
            Cells(1, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet2").name = "通補合計"
            
        
            Sheets("Sheet1").Select
            Sheets("Sheet1").name = fgsname
            Workbooks(sheetname).Save
            ActiveWorkbook.CheckCompatibility = False
         
            ActiveWindow.Close
             Windows(FilesName).Activate
            

        Next
       
       MsgBox "拆分完成"
    End If
End Sub

Private Sub OpenFile_Click()
    FilePath1 = Application.GetOpenFilename()
End Sub

Private Sub SaveFile_Click()
    '通過打開文件夾的形式取得文件夾路徑
    Dim strPath As String
    Dim MyFileDialog As FileDialog
    Set MyFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    '當對話框關閉時".show=-1"
    If MyFileDialog.Show = -1 Then
    '使用循環顯示選取文件的路徑和名稱
    For Each vrtSelectedItem In MyFileDialog.SelectedItems '遍歷在對話框中選擇的多個文件夾，其實只能選擇一個文件夾
    strPath = vrtSelectedItem
    Next
    End If
    FilePath2 = strPath & "\"
End Sub

Public Function SheetExists(BName As String)
    Dim Ws As Worksheet
    On Error Resume Next
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
    End If
End Function


Public Function SubCompany()
  
        Sheets("sheet1").Select
        Cells.Select
        Selection.Delete
        
        Sheets("收入").Select
        
            Rows("2:5").Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("2:5").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("8:11").Select
            ActiveSheet.Paste
            
        Sheets("網絡開發").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("16:19").Select
            ActiveSheet.Paste
            
        Sheets("單店產出").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("24:27").Select
            ActiveSheet.Paste
            
             
        Dim i As Long
        Dim fgsname, sheetname As String
        For i = 6 To 39
            
        Sheets("收入").Select
        
            fgsname = Range("B" & i).Value
            Rows(i & ":" & i).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("6:6").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("12:12").Select
            ActiveSheet.Paste
        
            
        Sheets("網絡開發").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("20:20").Select
            ActiveSheet.Paste
            
        Sheets("單店產出").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("28:28").Select
            ActiveSheet.Paste
        
           
            Cells.Select
            Selection.Copy
            Workbooks.Add
            Cells.Select
            ActiveSheet.Paste
            ActiveWorkbook.SaveAs FileName:=FilePath2 & fgsname & "2014年上半年產品總考覈得分.xlsx", _
                FileFormat:=xlExcel12, WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            sheetname = fgsname & "2014年上半年產品總考覈得分.xlsx"
            Windows(FilesName).Activate
            Sheets(Array("通補合計")).Select
            Application.CutCopyMode = False
            
            Sheets("通補合計").Select
            Cells.Select
            Selection.Copy
            Workbooks(sheetname).Activate
            
            Sheets.Add After:=ActiveSheet
            Sheets("Sheet2").Select
            Cells(1, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet2").name = "通補合計"
            
        
            Sheets("Sheet1").Select
            Sheets("Sheet1").name = fgsname
            Workbooks(sheetname).Save
            ActiveWorkbook.CheckCompatibility = False
         
            ActiveWindow.Close
            
            Windows(FilesName).Activate

        Next
End Function

發表評論
所有評論
還沒有人評論，想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章

使用vba操作工作表，實現報表彙總

表有哪些方法和屬性？ 方法也可以理解爲動作，表的方法有select，add, delete, copy，表的屬性有count,name 假設工作簿中按順序新建3張表叫1月和2月和3 月。如何切換到第2張表？ Sheet2.select /

职场老油条 2020-07-07 12:59:28

巧用公式實現VBA數組快速賦值

VBA中可以使用數組處理工作表中的數據，是個盡人皆知的祕密了，讀取數據加載到數組中也很簡單。 工作表中數據如下圖所示，需要將B1:G1的內容加載到數組中。 噠噠，一行代碼瞬間生成一個二維數組，不要問爲什麼是二維數組？爲什麼使用方

taller_2000 2020-07-06 21:15:22

VBA常用語法（一）

VBA語句 一、VBA語句 1.宏程序語句 運行後可 以完成一個功能。 ​`//給單元格a1賦值 Sub test() //開始語句 Range("a1") = 10 //程序主體 End Sub

stupid_Qiu 2020-07-06 15:06:47

VBA第一章，關於宏和for的基礎操作2

上一篇文章已經介紹了什麼是宏,什麼是vba以及如何使用宏和vba，還介紹了for的基礎用法。本篇文章我們通過另一個案例鞏固一下，也會學習將執行宏的操作簡化成點擊一個按鈕來執行 案例2 題目： 將工資錶轉換成工資條，在每一行員工工資記錄上一

挣扎的小笨笨 2020-07-07 08:22:54

VBA第一章，關於宏和for的基礎操作1

1、什麼是宏？   宏是一系列操作的集合 2、什麼是VBA？   VBA是編寫宏的工具 看了上面兩個問題，大家可能不太明白，希望看了這篇文章可以讓你豁然開朗！ 如何打開宏？ Excel10及以上版本，點擊文件-》選項-》自定義功能區-》勾

挣扎的小笨笨 2020-07-07 08:22:54

快速替換指定單詞

有個愛學習的小朋友要突擊英語，需要做一些填空題目，重要的單詞已經用下劃線標記出來了。 製作填空題時，需要保留單詞的第一個字母，這樣可以提示答題者，後面是空格由於填空。 如果按人工逐個單詞去修改，估計要搞到地老天荒了，幸好有VB

taller_2000 2020-07-06 21:15:22

清空合併單元格之隱藏單元格

合併單元格有真有假，如果大家不知道二者的區別，請移步《Excel合併單元格之真假李逵》先了解一下。識別兩種合併單元格的方法也很簡單，輔助列使用公式讀取一下單元格內容，如果合併單元格之隱藏單元格仍然有內容，那麼這就是粘貼格式創建的合

taller_2000 2020-07-06 21:15:22

轉載：哈希函數 形象說明

哈希表與哈希函數        hash表，有時候也被稱爲散列表。個人認爲，hash表是介於鏈表和二叉樹之間的一種中間結構。鏈表使用十分方便，但是數據查找十分麻煩；二叉樹中的數據嚴格有序，但是這是以多一個指針作爲代價的結果。hash表既滿

qq7652401741 2020-07-06 19:28:01

對工作簿進行操作（add、open、copy、save、close）

Add方法創建工作簿或工作表 1、Add方法創建新的工作簿 語法：workbooks對象.add（temple）， 其中temple爲參數可選 另外還可以指定工作簿中工作表數量，如： Dim bbb As Workbook Appli

qq7652401741 2020-07-06 18:49:14

WorkSheet 的方法：add、delete、activate和select、copy、move；屬性：name、visible

  轉載：https://www.cnblogs.com/rhongp/p/6383782.html   WorkSheet和workSheets的關係：workSheet是單個工作表，workSheets是指定工作簿中所有工作表的集合。

qq7652401741 2020-07-06 18:49:14

VBA語法（2）

一、判斷語句 1. iF判斷 //單條件判斷 Sub 判斷1() If Range("a1").Value > 0 Then Range("b1") = "A1的值是正數" Else R

stupid_Qiu 2020-07-06 15:06:47

VC利用WORD替換功能打印發票

在用VC開發一項目時，需要打印發票。由於發票的種類比較多，而且有的是已經有文字，有的空白的，還有一部分文字是可變的，動態改變。如果用VC直接控制它的輸出，是一件很煩人的事情，而且工作量巨大，因此考慮到office的word文字操作軟件有傑

tiana2009 2020-07-07 12:35:10

Word 模板 - 新建嚮導

嚮導 Word 2010 Bible 上說有的模板，在基於它新建文件時，可以彈出一個新建嚮導。然後，我就特別地想實現這個功能，比如新建若干個節，新建目錄等。 跑到 http://word.mvps.org 上搜索了下，果然有方法，簡單的說

windtailljj 2020-07-07 08:49:14

VBA中Long和String分別做布爾運算的耗時

文章目錄概述測試速度的代碼測試結果結論 概述 用if做判斷時，數據類型對速度的影響有多大？是否值得添加修改類型的代碼？ 測試速度的代碼 Private Declare Function QueryPerformanceCounte

Never_Satisfied 2020-07-06 21:10:50

excle練習

1. excle 固定表頭其餘部分滾動查看           方法：在你準備固定的部分下面一行點擊鼠標，選擇“視圖”->選擇凍結空格 2.excle固定打印表頭           方法：選擇”頁面佈局“ -> “打印標題”，就可以將指

peter_666 2020-07-06 09:23:22