Excel VBA - Использование массивов, созданных в другом модуле - PullRequest
0 голосов
/ 17 декабря 2018

Я пытаюсь создать рабочую книгу, которая позволяет пользователю импортировать некоторые виды основных данных, импортировать некоторые данные, которые вы хотите сравнить с основными данными, и в конечном итоге выполнить анализ этих данных.Как основные, так и импортированные данные могут быть рабочей книгой (т. Е. Несколькими листами).

Моя идея состоит в том, чтобы сгруппировать рабочие листы в массив главных листов и импортированный массив листов, чтобы я мог ссылаться на них в коде анализа.В настоящее время мне удалось создать эти два массива в двух отдельных модулях (2 кнопки нажатия), но у меня нет возможности использовать массивы в третьем модуле.

Есть ли способ сделать это?или я ошибаюсь, что использовал этот подход в первую очередь?

ниже будут мои коды.

Sub ImportMaster_Click()

Dim sImportFile As String, sFile As String, sSheetName As String
Dim sThisBk As Workbook
Dim wbBk As Workbook
Dim wsSht As Worksheet
Dim vfilename As Variant
Dim Mshtarray()
Dim MshtName As String
Dim lSheetNumber As Long
Dim lshtcount As Long
Dim iMshtcount As Integer
Dim x As Integer
Dim y As Integer

'import data that you want to compare with master data

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename(Title:="Open File")
If sImportFile = "False" Then
    MsgBox "No File Selected"
    Exit Sub
Else
    vfilename = Split(sImportFile, "\")
    sFile = vfilename(UBound(vfilename))
    Application.Workbooks.Open Filename:=sImportFile


    Set wbBk = Workbooks(sFile)

    With wbBk
        lSheetNumber = wbBk.Worksheets.Count
        If lSheetNumber > 1 Then

           x = 0
            For iMshtcount = 1 To lSheetNumber
                x = x + 1
                ReDim Preserve Mshtarray(0 To iMshtcount)
                Mshtarray(x) = wbBk.Sheets(x).Name

            Next

            If IsArray(Mshtarray) = True Then

                For y = 1 To x
                    If Mshtarray(y) <> "Import page" Then
                            lshtcount = sThisBk.Worksheets.Count
                            wbBk.Sheets(Mshtarray(y)).Copy after:=sThisBk.Sheets(lshtcount)


                    End If
                Next
            Else
                MsgBox "Array error"
            End If
            sThisBk.Sheets("Import page").Select

        ElseIf lSheetNumber = 1 Then

            MshtName = ActiveSheet.Name

            If SheetExists(MshtName) Then
                Set wsSht = .Sheets(MshtName)
                wsSht.Copy after:=sThisBk.Sheets("Import page")
            Else
                MsgBox "There is no Sheet with name :  in:" & vbCr & .Name
            End If
            sThisBk.Sheets("Import page").Select

        Else

            MsgBox "Error, no worksheet opened"


        End If


        wbBk.Close SaveChanges:=False



    End With
End If



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Public Function SheetExists(ByVal sWSName As String, Optional wb As Workbook) As Boolean

Dim sht As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
Set sht = wb.Sheets(sWSName)
On Error GoTo 0
SheetExists = Not sht Is Nothing

End Function

Модуль для импорта данных аналогичен приведенному выше.проблема заключается в третьем модуле, в котором я хочу сравнить данные.

Sub Reporting_Click()

Dim wbBk As Workbook
Dim wsSht As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim lastvisRow As Long
Dim readN3 As Integer
Dim maxN3 As Integer
Dim shtcount As Integer
Dim fltrng As Range
Dim a As Long


Set wbBk = ActiveWorkbook
Set wsSht = ThisWorkbook.Sheets
'vMshtname = ThisWorkbook.Sheets(Module1.Mshtarray(y)) <----- I have error for calling such array here
'vImshtname = ThisWorkbook.Sheets(Module3.Imshtarray(j))

Application.DisplayAlerts = False

For Each wsSht In wkbk.Worksheets
 shtcount = ThisWorkbook.Worksheets.Count
 Set wsSht = ThisWorkbook.Worksheets <---- problem for setting worksheets as well since I can see wsSht is still nothing after running this line 


with wsSht
    a = 2
    For a = 2 To a = shtcount <---- ******

    If ThisWorkbook.Sheets(a).Name <> "Import page" Then

        wsSht.AutoFilterMode = False
        lastRow = wsSht.UsedRange.Rows.Count
        wsSht.Range("D6").AutoFilter Field:=4, Criteria1:=">=0", Operator:=xlAnd, Criteria2:="<>="


        Set fltrng = wsSht.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        firstRow = fltrng.Range("E1").End(xlUp).Row
        lastvisRow = fltrng.Range("E1").End(xlDown).Row
        readN3 = Application.WorksheetFunction.Max(Range("E" & firstRow, "E" & lastvisRow))
        maxN3 = 0
        If maxN3 < readN3 Then
            maxN3 = readN3
        End If

    Else

        MsgBox "No data available for analysis"
    End If

Next

End With

Даже когда я просто хочу попробовать коды в цикле for, VBA может работать только на строке с ****** и затем напрямую пропускается до конца саб.Может ли кто-нибудь помочь мне здесь, пожалуйста?!

1 Ответ

0 голосов
/ 17 декабря 2018

Управляющая переменная отсутствует (неправильно)

Я исправил ошибки, но я не знаю, что вы пытаетесь сделать с массивами.Попробуйте объяснить.

Option Explicit

Sub Reporting_Click()

Application.DisplayAlerts = False

Dim wbBk As Workbook
Dim wsSht As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim lastvisRow As Long
Dim readN3 As Integer
Dim maxN3 As Integer
Dim shtcount As Integer
Dim fltRng As Range
Dim a As Long

'vMshtname = ThisWorkbook.Sheets(Module1.Mshtarray(y)) <----- I have error for calling such array here
'vImshtname = ThisWorkbook.Sheets(Module3.Imshtarray(j))

Set wbBk = ActiveWorkbook

' shtcount = wbBk.Worksheets.Count
' For a = 2 To shtcount
'     With wbBk.Worksheets(a)
'
'     End With
' Next

' Or
For Each wsSht In wbBk.Worksheets
    With wsSht
        If .Name <> "Import page" Then
            .AutoFilterMode = False
            lastRow = .UsedRange.Rows.Count
            .Range("D6").AutoFilter Field:=4, Criteria1:=">=0", _
                    Operator:=xlAnd, Criteria2:="<>="
            Set fltRng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
            With fltRng.Range("E1")
                firstRow = .End(xlUp).Row
                lastvisRow = .End(xlDown).Row
            End With
            readN3 = Application.WorksheetFunction _
                    .Max(Range("E" & firstRow, "E" & lastvisRow))
            maxN3 = 0
            If maxN3 < readN3 Then
                 maxN3 = readN3
            End If
          Else
            MsgBox "No data available for analysis"
        End If
    End With
Next

End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...