寫入集保庫存檔案版.VBA

寫入集保庫存檔案版.VBA

Private Sub CommandButton1_Click()

 '標題
    NEW_TAG = Array("DATE", "999", "999股數", "1000", "1000股數", "5000", "5000股數", "10000", "10000股數", "15000", "15000股數", "20000", "20000股數", "30000", "30000股數", "40000", "40000股數", "50000", "50000股數", "100000", "100000股數", "200000", "200000股數", "400000", "400000股數", "600000", "600000股數", "800000", "800000股數", "1000000", "1000001股數")
                       
    I = 1
    
    Source = Excel.ActiveWorkbook.Name '儲存目前作業中檔案名稱

Do While Sheets("工作表1").Range("A" & I) <> ""

        Sheets("集保戶股權分散表").Range("I1") = "證券代號"

        Sheets("集保戶股權分散表").Range("I2") = Sheets("工作表1").Range("A" & I) '每次迴圈執行的股票代號
        
        STOCK_ID = Sheets("工作表1").Range("A" & I)
        
        Sheets("工作表3").Cells.Clear
        
        Sheets("工作表3").Range("A1:AE1") = NEW_TAG
    
        Call 進階篩選個股 '可以自己錄製或是參考

        'Excel Vba 如何整理股權分散表(集保庫存) 一、進階篩選個股 (AdvancedFilter )

        COUNT_集保 = Application.CountA(Sheets("集保戶股權分散表").Range("M1:M100"))
    
        A = Sheets("集保戶股權分散表").Range("M2:O" & COUNT_集保) '集保篩選的資料
        
        K = Sheets("集保戶股權分散表").Range("K2") 'DATE
        
       FILE_PATH = ThisWorkbook.Path & "\" & STOCK_ID & ".xls"
       
       檢查檔案存在_C = 檢查檔案存在(FILE_PATH)
       
       If 檢查檔案存在_C = 1 Then
                
                '存在時開啟檔案寫入資料。
                
                 Workbooks.Open Filename:=FILE_PATH
        
                 WORKNAME = Excel.ActiveWorkbook.Name
                       
                 Windows(WORKNAME).Activate
   
                 COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row + 1
                
                 ActiveSheet.Range("A" & COUNT_寫入) = K
                 
                 X1 = 2
                 
                 X2 = 3
                     
                 For X3 = LBound(A) To UBound(A) - 2 Step 1
                     
                     ActiveSheet.Cells(COUNT_寫入, X1) = A(X3, 2)
                     
                     ActiveSheet.Cells(COUNT_寫入, X2) = A(X3, 3)
                     
                     X1 = X1 + 2
                     
                     X2 = X2 + 2
                 
                 Next X3
                 
                  COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row
                  
                  Dim myRange As Range
                        Set myRange = ActiveSheet.Range("A1:AE" & COUNT_寫入)
                        myRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes
                        
                        COUNT_寫入 = ActiveSheet.Range("A2000").End(xlUp).Row
                 
                  ActiveSheet.Range("A1:AE" & COUNT_寫入).Sort Key1:=ActiveSheet.Range("A1"), Order1:=xlDescending, Header:=xlYes, _
                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                :=xlStroke, DataOption1:=xlSortNormal
                 
                 Workbooks(WORKNAME).Save
                 
                 Workbooks(WORKNAME).Close
                 
       
       Else
                Sheets("工作表3").Cells.Clear
                
                Sheets("集保戶股權分散表").Range("K:P").Clear '清除前回執行結果
                
                 Sheets("工作表3").Range("A1:AE1") = NEW_TAG
                
                 COUNT_寫入 = Sheets("工作表3").Range("A2000").End(xlUp).Row + 1
                
                Sheets("工作表3").Range("A" & 2) = K

                    X1 = 2
                    
                     X2 = 3
                    
                    For X3 = LBound(A) To UBound(A) - 2 Step 1
                    
                     ActiveSheet.Cells(COUNT_寫入, X1) = A(X3, 2)
                    
                     ActiveSheet.Cells(COUNT_寫入, X2) = A(X3, 3)
                    
                     X1 = X1 + 2
                    
                     X2 = X2 + 2
                    
                    Next X3
                        
                Sheets("工作表3").Copy
                
                WORKNAME = Excel.ActiveWorkbook.Name
                
                Workbooks(WORKNAME).Activate
                
                ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & STOCK_ID & ".xls", FileFormat:=56
                
                WORKNAME = Excel.ActiveWorkbook.Name
                
                Workbooks(WORKNAME).Close
       
       End If

     I = I + 1  'I是控制取得ActiveSheet.Range("H" & I)儲存格資料的步進值
    
     Workbooks(Source).Activate
  
Loop

End Sub

https://riverfootmark.blogspot.com/2020/10/excel-vba_24.html

https://riverfootmark.blogspot.com/2020/10/excel-vba_24.html