Compile error sub or function not defined как исправить

This is a code that goes through the cells in column B in sheet2. If it finds a value that is not a date in column B, then it copies it, pastes it another sheet called ‘errors’ and then deletes that row from Sheet2. Whenever I try to run this, however, I get a ‘Compile Error: Sub or function not defined’. I saw some other posts on this, but nothing mentioned there seemed to work for me.

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheet("Errors").CountA("A1:A100")

    For Each i In Worksheet("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheet("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub

asked Sep 14, 2018 at 12:25

Indradeap Chatterjee's user avatar

There are a few other errors/changes that could be made within the script

  1. Add s to Worksheet
  2. Use Option Explicit at top of code
  3. Application.WorksheetFunction.CountA
  4. Add range as argument to Counta i.e. Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
  5. Ensure correct ranges being worked with by wrapping in With Worksheets("Sheet2")
  6. Determine last row by coming up from bottom of sheet with .Cells(.Rows.Count, "A").End(xlUp).Row, or you could end up looping to bottom of sheet
  7. Correct syntax for delete line: i.EntireRow.Delete
  8. You can put copy paste on one line: .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
  9. Be wary of using End(xlToRight) in cases of potentially ending up at far right of sheet.
  10. Optimize code by switching some things off e.g. prevent repaint by switching off screen-updating during looping
  11. Gather ranges to delete with Union and delete in 1 go or loop backwards to delete

VBA:

Option Explicit
Public Sub removeerrors()
    Dim i As Range, x As Double, loopRange As Range, lastRow As Long, unionRng As Range
    x = Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set loopRange = .Range("A2:A" & lastRow)
        If lastRow = 1 Then Exit Sub
        For Each i In loopRange
            If Not IsDate(i.Offset(0, 1)) Then
                .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, i)
                Else
                    Set unionRng = i
                End If
            End If
        Next i
    End With
    If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

answered Sep 14, 2018 at 12:43

QHarr's user avatar

QHarrQHarr

83.1k12 gold badges54 silver badges100 bronze badges

0

You just need to change Worksheet to Worksheets with ‘s’ at the end.

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheets("Errors").CountA("A1:A100")

    For Each i In Worksheets("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheets("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub

answered Sep 14, 2018 at 12:31

Kirszu's user avatar

KirszuKirszu

3523 silver badges11 bronze badges

use fully qualified range references

loop backwards when deleting rows

update target sheet pasting row index

as follows

Option Explicit

Sub removeerrors()
    Dim iRow As Long
    Dim x As Double
    x = Worksheets("Errors").CountA("A1:A100")

    With Worksheets("Sheet2") ' referecne "Sheet2" sheet
        With .Range(.Range("A2"), .Range("A2").End(xlDown))  ' reference referenced sheet range from cell A2 down to next not empty one
            For iRow = .Rows.Count To 1 Step -1 ' loop reference range backwards from its last row up
                If Not IsDate(.Cells(iRow, 2)) Then ' if referenced range cell in column B current row is not a date
                    .Range(.Cells(iRow, 1), .Cells(iRow, 1).End(xlToRight)).Copy Destination:=Worksheets("Errors").Range("A1").Offset(x, 0) ' copy referenced range current row spanning from column A to next not empty column and paste it to sheet "Errors" column A row x
                    x = x + 1 ' update offset
                    .Rows(1).EntireRow.Delete ' delete referenced range current row
                End If
            Next
        End With
    End With
End Sub

answered Sep 14, 2018 at 13:01

DisplayName's user avatar

DisplayNameDisplayName

13.2k2 gold badges11 silver badges19 bronze badges

Return to VBA Code Examples

This article will explain the VBA sub or function not defined error.

vba sub not defined

When one has finished writing VBA code, it is a good idea to compile the code to check if there are any errors that may occur when running the code. If there are compile errors, a compile error warning will appear. One of these errors may be the Sub or Function not defined error. There can be a few reasons that this error occurs.

Misspelled Sub or Function

The most common reason for this error occurring is a spelling mistake!

Let us take the code below as an example:

Function GetTaxPercent(dblP as Double) As Double
  GetTaxPercent = dblP*0.15
End Function
Sub GetPrice()
  Dim dblPrice As Double
  Dim dblTax As Double
  dblPrice = Range("A1")
  dblTax = GetTaxPerc(dblPrice)
End Sub

In the above example, we have created a function to fetch the tax percentage value (15%).

In the second procedure, I am trying to call that function to get the tax on a certain value in range A1.

vba sub not defined spell

However, when I run the code, I get the compile error as I have spelt the function that I am calling incorrectly. This is an easily made mistake, especially in large VBA projects with lots of procedures and modules. The best way to prevent these errors at run time, is to compile the code before releasing it to your users.

In the Menu, click Debug > Compile VBAProject.

vba sub not defined compile

Any compile errors will then be highlighted in the code in order for you to fix them.

Missing Sub or Function

It may be that a sub or function just does not exist! Once again, if you have a large VBA project, it can be possible to delete a sub or function by mistake. If this is the case, you would unfortunately need to re-write the function. Always a good idea to have backups for this reason!

Incorrect Scope of Sub of Function

It may be the case that the sub or function does exist, and is spelt correctly, but the scope of the sub or function is incorrect. In the example below, the GetTaxPercent function is in a different module to the GetPrice sub that is calling it, and it has been marked Private. It therefore cannot be seen by the GetPrice sub procedure.

vba sub not defined scope

If we remove the word private in front of the Function, then the module will compile.

vba ambiguous compiled

What’s worse than getting a runtime error in Excel VBA? A compile error. That’s because the actual error is not always highlighted, rather the opening Sub or Function statement. “Sub or Function not Defined” indicates a compile error. VBA displays this message when it cannot find what is referenced by name. This article gives several examples of this compile error and how to correct them.

popup message box showing compile error: sub or function not defined

VBA is compiled (translated) into machine language before it is executed. Compile errors halt the compile process before procedures are executed.

Best practice:  Frequently check for compile errors from VB Editor. From the Debug menu, choose Compile VBAProject. No news is good news when nothing seems to happen.

Issue 1: Typos

Typos are the most common cause of “Sub or Function not Defined.” If Excel highlights (in yellow or gray) the keyword or procedure it can’t find, you have a great head start on your game of Hide and Seek.

Best practice:  Follow Microsoft’s naming convention and always include at least one capital letter whenever you create a name (exception: counter variables like n). Always type the name in lower case. When you leave the statement, and the name stays in all lower case, you have found a typo.

Contrary to its message, “Sub or Function not Defined” is not limited to procedures. The statement below causes this message. Can you find the typo?

          Worksheet("Summary").Select

Worksheets is the required keyword. The “Summary” worksheet object is a member of the Worksheets collection. The Worksheets collection contains all the worksheet objects of a workbook. Excel VBA has several collections.

Tip: All VBA collections end with “s”:  Workbooks, Sheets, Cells, Charts, etc.

Issue 2: Worksheet Functions

VB Editor may be the backstage to the worksheets in front, but not all worksheet props have been brought backstage. These “props” are functions that don’t exist in VBA. Worksheet functions like CountA cause “Sub or Function not Defined”:

          intCount = CountA("A:A")

The WorksheetFunction object is the “stage hand” that lets you call worksheet functions from VBA, like this:

          intCount = WorksheetFunction.CountA("A:A")

Issue 3: Missing Procedure

Less frequently, the called procedure is truly missing. After you check for typos, and you’re sure you coded the called procedure, perhaps you are missing a library. Tools, References is the next place to look.

From VB Editor Tools menu, choose References. The References dialog box opens. If VBA has identified a missing library, the last library with a checkmark will start with MISSING, followed by its name. Most of the time, you can simply scroll down the alphabetical list of libraries and check the missing library, then choose OK.

Fortunately, a missing library happens infrequently, usually related to a recent change. Perhaps you upgraded to a newer version of Excel. You purchased a new computer. You received a workbook from someone with an older version of Excel. Or you created your first macro that calls Solver Add-In.

The Solver project is not added to VBA when you enable the Solver Add-In, as shown below. At Solver project is near the top of the list of references, so you don’t have to scroll down to find it.

the references dialog box in vba

Your own macro workbooks can behave like Solver. Every Excel workbook has a built-in VBAProject. See MyFunctions in the screenshot above? MyFunctions is simply VBAProject renamed in a macro workbook. The workbook is open, so the Subs in MyFunctions run from the Developer tab. Even so, “Sub or Function not Defined” occurs when MyFunctions is not checked, and a procedure is called from a different macro. Simply check its project as an available reference.

Best practice:  Assign your VBA projects a meaningful name. From Project Explorer, right click the macro workbook. Choose VBAProperties, then type a Project Name with no spaces.

Issue 4: Unavailable Procedures

“Sub or Function not Defined” also occurs when the procedure is not available to the calling procedure in the same workbook. This error is related to Public vs. Private procedures. By default, Sub and Functions in standard modules of the Modules folder (seen in Project Explorer) are public. Standard procedures can be called by any procedure in the project. You can make a procedure private by adding the Private keyword, like this:

          Private Sub Initialize()

Tip:  All the macros shown in the Macros dialog box of the Developer tab are Public. The list excludes public functions.

Subs and Functions in worksheet modules are private. They can only be called from the worksheet (like clicking a button) or another procedure in that module. The same is true for user forms.

You can remedy “Sub or Function not Defined” by deleting the Private keyword from a procedure in a standard module. Sorry, you cannot remedy calling a procedure in a worksheet module from another module. Think of standard modules like public parks, and worksheet modules like private property. No trespassing allowed!

Issue 5: Declaring a Routine That Doesn’t Exist in the Specified DLL

The sub you’re trying to use could be a part of a DLL that needs to be referenced. So not declaring a DLL or declaring the wrong one will cause the compiler to not find the sub or function that you are trying to use.

A DLL is a dynamically linked library of a body of code that is compiled and is meant to provide some functionality or data to an executable application (like the VBA project we’re working with). A dynamic library is loaded by the VBA project when it needs it. DLLs are used in order to save developers time by utilizing built and tested bodies of code.

You will need to do some research to determine the library that your sub or function belongs to, then declare it in your code using the Declare keyword in its simplest form:

Declare Sub sub_name Lib “library_name”

To read more about accessing DLL functions and subs from VBA, check out: https://docs.microsoft.com/en-us/office/client-developer/excel/how-to-access-dlls-in-excel

Issue 6: Forgetting to Write It

Finally, it’s possible that it just hasn’t been written yet!

If you realize that the sub that has been highlighted for you by the VBA compiler doesn’t exist, then the solution is to create it. To know whether it exists or not, just search for it on the project level using the Find tool in the VBA IDE.

vba IDE find button

Selecting the ‘Current Project’ scope will allow you to search for the sub in the entire workbook. You can also do that for the other workbooks where the sub might reside.

searching for a particular sub in the vba ide

Wrap Up

“Sub or Function not Defined” is a compile error that occurs when VBA cannot find a procedure or other reference by name. A typo is the most common cause of this message.

See also: Compile Error: Expected End of Statement and Compile Error: User-defined Type Not Defined

Additional assistance from Mahmoud Mostafa

  • Question

  • Compile Error Sub or Function not defined. Arrow points and highlight “Sub Variable ()”

    Will not begin working at all. Do I have to make a reference to the excel sheet even if I recorded it in the worksheet?

    Am I not allowed to name it variable?

    Also, How can I get macro to ask for input of objective cell goal? I wanted the value to make a cell reference but excel solver would not allo this, therefore this data will change as the other solvers are run. I need macro to ask for a value input so that
    it may continue its progress.

    Sub Variable()

    ‘ Variable Macro
    ‘ Find variables best fit to model data. Set X_1 Objective Cell = AC21

    ‘ Keyboard Shortcut: Ctrl+f

       
        SolverOk SetCell:=”$AC$23″, MaxMinVal:=3, ValueOf:=0.2041563087937, ByChange:= _
            “$J$3:$J$4″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$L$235″, MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            “$J$1:$J$2,$J$5,$J$8:$J$9″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverLoad LoadArea:=”$J$1:$J$2,$J$5,$J$8:$J$9″
        SolverOk SetCell:=”$L$235″, MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            “$J$1:$J$2,$J$5,$J$8:$J$9″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$L$235″, MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            “$J$1:$J$2,$J$5,$J$8:$J$9″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverSolve
        ActiveWindow.ScrollRow = 200
        ActiveWindow.ScrollRow = 197
        ActiveWindow.ScrollRow = 196
        ActiveWindow.ScrollRow = 194
        ActiveWindow.ScrollRow = 191
        ActiveWindow.ScrollRow = 188
        ActiveWindow.ScrollRow = 185
        ActiveWindow.ScrollRow = 179
        ActiveWindow.ScrollRow = 171
        ActiveWindow.ScrollRow = 164
        ActiveWindow.ScrollRow = 156
        ActiveWindow.ScrollRow = 147
        ActiveWindow.ScrollRow = 139
        ActiveWindow.ScrollRow = 126
        ActiveWindow.ScrollRow = 116
        ActiveWindow.ScrollRow = 104
        ActiveWindow.ScrollRow = 87
        ActiveWindow.ScrollRow = 74
        ActiveWindow.ScrollRow = 65
        ActiveWindow.ScrollRow = 38
        ActiveWindow.ScrollRow = 16
        ActiveWindow.ScrollRow = 9
        ActiveWindow.ScrollRow = 7
        ActiveWindow.ScrollRow = 6
        ActiveWindow.ScrollRow = 3
        ActiveWindow.ScrollRow = 1
        SolverOk SetCell:=”$L$235″, MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            “$J$1:$J$2,$J$5,$J$8:$J$9″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$K$235″, MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            “$J$1,$J$5:$J$7″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverLoad LoadArea:=”$J$1,$J$5:$J$7″
        SolverOk SetCell:=”$K$235″, MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            “$J$1,$J$5:$J$7″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$K$235″, MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            “$J$1,$J$5:$J$7″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverSolve
        ActiveWindow.ScrollRow = 200
        ActiveWindow.ScrollRow = 199
        ActiveWindow.ScrollRow = 197
        ActiveWindow.ScrollRow = 195
        ActiveWindow.ScrollRow = 193
        ActiveWindow.ScrollRow = 189
        ActiveWindow.ScrollRow = 185
        ActiveWindow.ScrollRow = 179
        ActiveWindow.ScrollRow = 169
        ActiveWindow.ScrollRow = 159
        ActiveWindow.ScrollRow = 143
        ActiveWindow.ScrollRow = 120
        ActiveWindow.ScrollRow = 92
        ActiveWindow.ScrollRow = 64
        ActiveWindow.ScrollRow = 2
        ActiveWindow.ScrollRow = 1
        SolverOk SetCell:=”$K$235″, MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            “$J$1,$J$5:$J$7″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$AC$23″, MaxMinVal:=3, ValueOf:=0.204156, ByChange:= _
            “$J$3:$J$4″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverLoad LoadArea:=”$J$3:$J$4″
        SolverOk SetCell:=”$AC$23″, MaxMinVal:=3, ValueOf:=0.20417621235, ByChange:= _
            “$J$3:$J$4″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverOk SetCell:=”$AC$23″, MaxMinVal:=3, ValueOf:=0.20417621235, ByChange:= _
            “$J$3:$J$4″, Engine:=1, EngineDesc:=”GRG Nonlinear”
        SolverSolve
    End Sub

Answers

  • Will not begin working at all. Do I have to make a reference to the excel sheet even if I recorded it in the worksheet?

    Am I not allowed to name it variable?

    Also, How can I get macro to ask for input of objective cell goal? I wanted the value to make a cell reference but excel solver would not allo this,

    a) No.

    b) No, the issue is that you have to set a reference to the solver in the VBA references.

    c) Use Application.InputBox, see code below.

    Andreas.

    Sub Variable()
      Dim R As Range
      
      On Error Resume Next
      Set R = Application.InputBox("Select a cell", Type:=8)
      If R Is Nothing Then Exit Sub
      On Error GoTo 0
      
        SolverOk SetCell:=R.Address, MaxMinVal:=3, ValueOf:=0.2041563087937, ByChange:= _
            "$J$3:$J$4", Engine:=1, EngineDesc:="GRG Nonlinear"
            
            
        SolverOk SetCell:="$L$235", MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            "$J$1:$J$2,$J$5,$J$8:$J$9", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverLoad LoadArea:="$J$1:$J$2,$J$5,$J$8:$J$9"
        SolverOk SetCell:="$L$235", MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            "$J$1:$J$2,$J$5,$J$8:$J$9", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverOk SetCell:="$L$235", MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            "$J$1:$J$2,$J$5,$J$8:$J$9", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve
        
        SolverOk SetCell:="$L$235", MaxMinVal:=3, ValueOf:=0.333, ByChange:= _
            "$J$1:$J$2,$J$5,$J$8:$J$9", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverOk SetCell:="$K$235", MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            "$J$1,$J$5:$J$7", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverLoad LoadArea:="$J$1,$J$5:$J$7"
        SolverOk SetCell:="$K$235", MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            "$J$1,$J$5:$J$7", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverOk SetCell:="$K$235", MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            "$J$1,$J$5:$J$7", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve
        
        SolverOk SetCell:="$K$235", MaxMinVal:=3, ValueOf:=0.17, ByChange:= _
            "$J$1,$J$5:$J$7", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverOk SetCell:="$AC$23", MaxMinVal:=3, ValueOf:=0.204156, ByChange:= _
            "$J$3:$J$4", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverLoad LoadArea:="$J$3:$J$4"
        SolverOk SetCell:="$AC$23", MaxMinVal:=3, ValueOf:=0.20417621235, ByChange:= _
            "$J$3:$J$4", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverOk SetCell:="$AC$23", MaxMinVal:=3, ValueOf:=0.20417621235, ByChange:= _
            "$J$3:$J$4", Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve
    End Sub
    

    • Marked as answer by

      Thursday, July 17, 2014 7:35 AM

  • Hi,

    Before you can use the Solver VBA functions in the Visual Basic Editor, you must establish a
    reference to the Solver add-in. In the Visual Basic Editor, with a module active, click
    References on the Tools menu, and then select 
    Solver under Available References. More details please refer to

    Using the Solver VBA Functions.

    If you want to manipulate a cell, range or other Excel objects in a VBA macro, you could refer to the link below to learning more about Excel Object Model.

    Excel Object Model Overview


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.

    Click
    HERE to participate the survey.

    • Marked as answer by
      Luna Zhang – MSFT
      Thursday, July 17, 2014 7:35 AM

Sub SM_Z()  
‘  
‘ Макрос записан 02.03.2005 (Efimov)  
‘  
   FRM = “=MAX(‘[Список студентов.xls]Список групп’!R4C1:R13C1)”
   Range(“B5”).Formula = FRM  
   m = 3 + Range(“B5”).Value  
   ActiveSheet.Shapes(“Group”).Select  
   With Selection  
       .ListFillRange = “‘[Список студентов.xls]Список групп’!$B$4:$B$” & m
       .LinkedCell = “$I$3”  
       .DropDownLines = Range(“B5”).Value  
       .Display3DShading = True  
   End With  

     Range(“E2”).Select  
   ActiveCell.FormulaR1C1 = _  
       “=VLOOKUP(R3C9,'[Список студентов.xls]Список групп’!R4C1:R13C2,2)”
       ActiveSheet.Shapes(“Bill”).Select  
   GR = Range(“E2”).Value  
   FRM = “=MAX(‘[Список студентов.xls]” & GR & “‘!R8C1:R38C1)”
   Range(“A5”).Formula = FRM  
   m = 7 + Range(“A5”).Value  
   With Selection  
       .ListFillRange = “‘[Список студентов.xls]” & GR & “‘!$B$8:$B$” & m
       .LinkedCell = “$A$4”  
       .MultiSelect = xlNone  
       .Display3DShading = True  
   End With  
   FRM = “=VLOOKUP(R4C1,'[Список студентов.xls]” & GR & “‘!R4C1:R” & m & “C4,2)”
   Range(“B4”).Select  
   ActiveCell.FormulaR1C1 = FRM  

         FRM = “=VLOOKUP(R4C1,'[Список студентов.xls]” & GR & “‘!R4C1:R” & m & “C4,3)”
   Range(“D4”).Select  
   ActiveCell.FormulaR1C1 = FRM  

         FRM = “=VLOOKUP(R4C1,'[Список студентов.xls]” & GR & “‘!R4C1:R” & m & “C4,4)”
   Range(“F4”).Select  
   ActiveCell.FormulaR1C1 = FRM  

         If ActiveSheet.Name = “Задание” Then  
       Prep = “='[Список студентов.xls]” & GR & “‘!R5C4”
       Range(“I23”).Formula = Prep  
   End If  
End Sub  

  Sub Print_zsm()  
‘  
   N = Range(“A5”)  
   For i = 1 To N  
       Range(“A4”).Value = i  
       Application.Run “‘Комплектование машин по объектам строительства__мг_mod.xls’!GSN”  
       pa = “A1:” & Cells(1, 1)  
       ActiveSheet.PageSetup.PrintArea = pa  
       ActiveSheet.PageSetup.PrintArea = pa  
       With ActiveSheet.PageSetup  
           .LeftMargin = Application.InchesToPoints(0.78740157480315)  
           .RightMargin = Application.InchesToPoints(0.78740157480315)  
           .TopMargin = Application.InchesToPoints(0.78740157480315)  
           .BottomMargin = Application.InchesToPoints(0.78740157480315)  
           .HeaderMargin = Application.InchesToPoints(0.511811023622047)  
           .FooterMargin = Application.InchesToPoints(0.511811023622047)  
           .PrintQuality = 600  
           .CenterHorizontally = True  
           .CenterVertically = True  
           .Orientation = xlLandscape  
           .PaperSize = xlPaperA4  
           .FitToPagesWide = 1  
           .FitToPagesTall = 1  
       End With  
       ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True  
   Next i  
End Sub  
Sub GSN()  
‘  
‘ Макрос1 Макрос  
‘ Макрос записан 18.06.2009 (Владимир Ефимов)  
‘  

  ‘  
   Dim c(8) ‘ массив для значений ядра  
   Dim s(200) ‘ массив для случайных чисел  
   c(1) = 37584381  
   c(2) = 190999663  
   c(3) = 196446317  
   c(4) = 123567149  
   c(5) = 1480745561  
   c(6) = 442596621  
   c(7) = 340029183  
   c(8) = 203022663  

       Range(“F3”).Select  
   ActiveCell.FormulaR1C1 = _  
       “=RIGHT(RC[-2],LEN(RC[-2])-FIND(“”-“”,RC[-2],LEN(RC[-2])-3))”
   nc = Cells(3, 6)  
   If nc > 8 Then nc = 8  
   mn = Len(Cells(4, 2)) & Len(Cells(4, 4)) & Len(Cells(4, 6)) + Cells(4, 1)  
   mnm = mn Mod 2  
   If mnm = 0 Then mn = mn + 1  
   bb = c(nc) * mn  
   mn = Right(bb, 4)  
   For i = 1 To 200  
      bb = c(nc) * mn  
      mn = Right(bb, 4)  
      s(i) = Right(bb, 8) / 100000000  
      ‘Cells(i + 5, 9) = s(i)  
   Next i  
‘  
‘———   конец генератора случайных чисел ——–  
‘  
   ni = 10  
   nj = 10  
   For i = 1 To ni  
      For j = 1 To nj  
          k = j + nj * (i – 1)  
          Cells(i + 9, j + 1) = Cells(10, 12) – Cells(10, 13) + 2 * Cells(10, 13) * s(k)  
      Next j  
   Next i  
‘  
‘  ——- заполнили матрицу затрат  
‘  
   If ActiveSheet.Name = “Решение” Then  
       [B56:K65] = 0
       SolverOk SetCell:=”$D$54″, MaxMinVal:=2, ValueOf:=”0″, ByChange:=”$B$56:$K$65″  
       SolverSolve UserFinish:=True  
   End If  
End Sub  

  Sub Main_m()  
   Application.Run “‘Комплектование машин по объектам строительства__мг_mod.xls’!SM_Z”  
   Application.Run “‘Комплектование машин по объектам строительства__мг_mod.xls’!GSN”  
End Sub  

    Первый раз имею дело с макросами.  
Надеюсь то что надо скопировал

Добавить комментарий