слишком большая процедура

[abracadabra]

Не хочет выполняться процедура, пишет - слишком большая процедура.
У меня там много кода, много циклов, а вставляю в другую процедуру - не работает, т.к. основной цикл у меня в другой процедуре - и его не видит .
Что делать? .

[Al Khamid]

(©К.С

[Nicky]

Вынести в процедуру тело цикла

[abracadabra]

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

[abracadabra]

В этом постинге было под сотню килобайт кода.
Неотформатированного.

Впрочем, если бы он был отформатированным, ситуация существенно не менялась бы.

В следующий подобный безмозглый постинг будет удалён вместе с автором, до изучения последним смысла слова "аттач".

-- GSerg

[FaKk2]

Я на месте компилятора тоже послал бы тебя подальше.

[abracadabra]

спасибо,
Вы настоящие друзья

[Nicky]

Код: Выделить всё

For i ...
  'тело цикла
Next i

[abracadabra]

у меня тело цикла - конструкция With
With Application.Selection
Worksheets(1).Range(Cells(RowPos, 4), Cells(RowPos, 4)).Value = Laborwert.Parametername
Worksheets(1).Range(Cells(RowPos, 5), Cells(RowPos, 5)).Value = Laborwert.Zeit
Worksheets(1).Range(Cells(RowPos, 6), Cells(RowPos, 6)).Value = Laborwert.Datum
Worksheets(1).Range(Cells(RowPos, 7), Cells(RowPos, 7)).Value = Laborwert.Ergebnistext
Worksheets(1).Range(Cells(RowPos, , Cells(RowPos, ).Value = Laborwert.Normalwert
Worksheets(1).Range(Cells(RowPos, 9), Cells(RowPos, 9)).Value = Laborwert.Minwert
Worksheets(1).Range(Cells(RowPos, 10), Cells(RowPos, 10)).Value = Laborwert.Maxwert
Worksheets(1).Range(Cells(RowPos, 11), Cells(RowPos, 11)).Value = Laborwert.Messwert
Worksheets(1).Range(Cells(RowPos, 12), Cells(RowPos, 12)).Value = Laborwert.Einheit
Worksheets(1).Range(Cells(RowPos, 13), Cells(RowPos, 13)).Value = Laborwert.Gw
Worksheets(1).Range(Cells(RowPos, 14), Cells(RowPos, 14)).Value = Laborwert.Datum

End With

А цикл If - End If

Я пробовал выносить - но из этой процедуры основная данные не считывает

[Nicky]

у меня тело цикла - конструкция With
With Application.Selection
Worksheets(1).Range(Cells(RowPos, 4), Cells(RowPos, 4)).Value = Laborwert.Parametername
Worksheets(1).Range(Cells(RowPos, 5), Cells(RowPos, 5)).Value = Laborwert.Zeit
Worksheets(1).Range(Cells(RowPos, 6), Cells(RowPos, 6)).Value = Laborwert.Datum
Worksheets(1).Range(Cells(RowPos, 7), Cells(RowPos, 7)).Value = Laborwert.Ergebnistext
Worksheets(1).Range(Cells(RowPos, , Cells(RowPos, ).Value = Laborwert.Normalwert
Worksheets(1).Range(Cells(RowPos, 9), Cells(RowPos, 9)).Value = Laborwert.Minwert
Worksheets(1).Range(Cells(RowPos, 10), Cells(RowPos, 10)).Value = Laborwert.Maxwert
Worksheets(1).Range(Cells(RowPos, 11), Cells(RowPos, 11)).Value = Laborwert.Messwert
Worksheets(1).Range(Cells(RowPos, 12), Cells(RowPos, 12)).Value = Laborwert.Einheit
Worksheets(1).Range(Cells(RowPos, 13), Cells(RowPos, 13)).Value = Laborwert.Gw
Worksheets(1).Range(Cells(RowPos, 14), Cells(RowPos, 14)).Value = Laborwert.Datum

End With

А цикл If - End If

Я пробовал выносить - но из этой процедуры основная данные не считывает

With Application.Selection - не вижу смысла
А цикл If - End If - это как?

[abracadabra]

For i = 1 To Laborwert.Parameter.Count

If Laborwert.Parametername = "Blutsenkung" Then

With Application.Selection
Worksheets(1).Range(Cells(RowPos, 4), Cells(RowPos, 4)).Value = Laborwert.Parametername
Worksheets(1).Range(Cells(RowPos, 5), Cells(RowPos, 5)).Value = Laborwert.Zeit
Worksheets(1).Range(Cells(RowPos, 6), Cells(RowPos, 6)).Value = Laborwert.Datum
Worksheets(1).Range(Cells(RowPos, 7), Cells(RowPos, 7)).Value = Laborwert.Ergebnistext
Worksheets(1).Range(Cells(RowPos, , Cells(RowPos, ).Value = Laborwert.Normalwert
Worksheets(1).Range(Cells(RowPos, 9), Cells(RowPos, 9)).Value = Laborwert.Minwert
Worksheets(1).Range(Cells(RowPos, 10), Cells(RowPos, 10)).Value = Laborwert.Maxwert
Worksheets(1).Range(Cells(RowPos, 11), Cells(RowPos, 11)).Value = Laborwert.Messwert
Worksheets(1).Range(Cells(RowPos, 12), Cells(RowPos, 12)).Value = Laborwert.Einheit
Worksheets(1).Range(Cells(RowPos, 13), Cells(RowPos, 13)).Value = Laborwert.Gw
Worksheets(1).Range(Cells(RowPos, 14), Cells(RowPos, 14)).Value = Laborwert.Datum

End With
'выводит на лист Ексель данные
End If


RowPos = RowPos + 1





If Laborwert.Parametername = "Leukozyten" Then

то же самое и так циклов 40 на 30 - м пишет, что слишком большая процедура

[Igor_123]

abracadabra
а почему-бы весь этот блок with .. end with не вынести в отдельную функцию. Например:

Код: Выделить всё

Sub FillFields(RowPos As Long, Laborwert As Тип)
With Laborwert
    Worksheets(1).Cells(RowPos, 4).Value = .Parametername
    Worksheets(1).Cells(RowPos, 5).Value = .Zeit
    Worksheets(1).Cells(RowPos, 6).Value = .Datum
    Worksheets(1).Cells(RowPos, 7).Value = .Ergebnistext
    Worksheets(1).Cells(RowPos, .Value = .Normalwert
    Worksheets(1).Cells(RowPos, 9).Value = .Minwert
    Worksheets(1).Cells(RowPos, 10).Value = .Maxwert
    Worksheets(1).Cells(RowPos, 11).Value = .Messwert
    Worksheets(1).Cells(RowPos, 12).Value = .Einheit
    Worksheets(1).Cells(RowPos, 13).Value = .Gw
    Worksheets(1).Cells(RowPos, 14).Value = .Datum
End With
End Sub

и вызывал бы её так
FillFields(RowPos, Laborwert)

а если Laborwert обект твоего класса, то добавил бы туда функциональность для цикла, наподобии метода Item у коллекций, тогда можно переделать ещё проще:

Код: Выделить всё

Sub FillFields(RowPos As Long, Laborwert As Тип)
Dim i As Long
For i = 0 To 9
    Worksheets(1).Cells(RowPos, i + 4).Value = Laborwert.Item(i)
Next i
End Sub

[abracadabra]

На Call FillFields(RowPos, Laborwert)
говорит "Несоответствие аргумента ByRef"

[Igor_123]

как выглядит объявление процедуры FillFields, т.е. эта строка:
Sub FillFields(RowPos As Long, Laborwert As Тип)
и вообще может сделаешь аттач с кодом по которому можно будет сказать что-то конкретнее

[abracadabra]

Уже не выскакивает сообщение "слишком большая процедура" после того, как я поменял свою конструкцию With на твою. Премного благодарен.
Но вызов функции с With не идёт.
в аттаче - код процедуры, переменные, объявленные вначале(а и т.д.) - это вместо ини-файла, с которым мне не удалось связать процедуру.

[Igor_123]

кто такой Laborwert и почему у тебя этот код повторяеться так много раз???

Код: Выделить всё

       If Laborwert.Parametername = b1 Then
            With Laborwert
                Worksheets(1).Cells(RowPos, 4).Value = .Parametername
                ...
                Worksheets(1).Cells(RowPos, 13).Value = .Gw
                Worksheets(1).Cells(RowPos, 14).Value = .Datum
            End With
        End If
   
        RowPos = RowPos + 1
   
        If Laborwert.Parametername = b2 Then
            With Laborwert
                Worksheets(1).Cells(RowPos, 4).Value = .Parametername
                ...
                Worksheets(1).Cells(RowPos, 14).Value = .Datum
            End With
        End If
   
        RowPos = RowPos + 1
   
        If Laborwert.Parametername = b3 Then
            With Laborwert
                Worksheets(1).Cells(RowPos, 4).Value = .Parametername
                ...
                Worksheets(1).Cells(RowPos, 14).Value = .Datum
            End With
        End If

Может ли Laborwert.Parametername возвращать значения не предусмотренные всеми условиями, которые есть в коде???

[Nicky]

Предлагаю поправить в консерватории

[Igor_123]

Предлагаю изменить так, если Laborwert.Parametername не возвращает значения не предусмотренные всеми условиями, которые есть в коде:

Код: Выделить всё

Dim DataAl As Object

Sub Patient()

    On Error Resume Next
    Dim i As Integer
    Dim Patient As Patient
    Dim Laborwert As Laborwert
    Dim Labordaten As Laborwerte
    Dim RowPos As Long
   
    Set DataAl = CreateObject("DataAL.Application")
    Set Patient = DataAl.Patient
    Set Labordaten = DataAl.Laborwerte
    'Если не созданы объекты, то и делать нечего. Можно вывести сообщение об этом
    If DataAl Is Nothing Or Patient Is Nothing Or Labordaten Is Nothing Then
        MsgBox "Не созданы объекты DataAL.Application"
        Exit Sub
    End If
   
    Patient.PatNr = InputPatNr()
    If (Patient.read() = 0) Then
        MsgBox ("Patient nicht gefunden")
    Else
        Worksheets(1).Range("E6").Value = "Patient:"
        Worksheets(1).Range("G6").Value = Patient.Vorname
        Worksheets(1).Range("H6").Value = Patient.Name
        Worksheets(1).Range("I6").Value = "geb. am"
        Worksheets(1).Range("J6").Value = Patient.Geburtsdatum
        PatNummer& = Patient.PatNr
        BesuchDatum = LetzterBesuch(PatNummer&)
        LabSelection = "PatNr=" + Str(PatNummer&)
       
        If BesuchDatum <> "" Then
            LabSelection = LabSelection + ";Datum>=" + BesuchDatum
        End If
        If Labordaten.Open(LabSelection) Then
            MsgBox ("Selektionsfehler")
        Else
            Worksheets(1).Select
            RowPos = 9
            Cells(8, 4).Value = "HAMATOLOGIE" 'a
            For Each Laborwert In Labordaten
                If Laborwert.Geraet = "" Then
                    ' Не понятно назначение этого цикла. По идее он должен перебирать каждый параметр
                    ' а он просто записывает одни и те-же данные столько раз, столько есть Parameter у объекта Laborwert
                    'For i = 1 To Laborwert.Parameter.count
                        ' следующая строка пишеться одно и то-же значениепри каждой итерации цикла
                        'Worksheets(1).Range(Cells(8, 4), Cells(8, 4)).Value = "HAMATOLOGIE" 'a
                        'RowPos = 9 ' а то здесь будет происходить перетирание данных из предыдущего Laborwert
                    With Laborwert
                        Cells(RowPos, 4).Value = .Parametername
                        Cells(RowPos, 5).Value = .Zeit
                        Cells(RowPos, 6).Value = .Datum
                        Cells(RowPos, 7).Value = .Ergebnistext
                        Cells(RowPos, .Value = .Normalwert
                        Cells(RowPos, 9).Value = .Minwert
                        Cells(RowPos, 10).Value = .Maxwert
                        Cells(RowPos, 11).Value = .Messwert
                        Cells(RowPos, 12).Value = .Einheit
                        Cells(RowPos, 13).Value = .Gw
                        Cells(RowPos, 14).Value = .Datum
                    End With
                    RowPos = RowPos + 1
                    'Next i
                End If
            Next Laborwert
            Labordaten.Close
        End If
    End If
    Set Labordaten = Nothing
    Set Patient = Nothing
    Set DataAl = Nothing
End Sub

[abracadabra]

Laborwert - объект, в котором содержатся лабораторные данные про пациента (в базе данных другой программы).
Задача такая - есть сгруппированные параметры - группа HAMATOLOGIE
и в ней параметры и др группы, нужно поочерёдно прощёлкать в Laborwert каждый параметр и если есть - записать, если нет, то следующий по очереди.
Получается Лабораторный лист в Екселе, на котором по группам поочерёдно параметры.
Суть не просто вытащить параметры, записанные в другой программе, а вывести их по шаблону.

[Igor_123]

Можно вывести, а потом отсортировать. В сортировке можно по трем полям задавать порядок сортировки. Так может эфективнее будет.
Предложенная мной процедура вываливает все данные в порядке следования Laborwert, а потом отсортировать уже по столбцам.

Если можно хотелось посмотреть кусочек данных после предложенной мной процедуры и как должно быть по итогу работы.

[abracadabra]

а как отсортировать по столбцам?

что значит кусочек кода и итог?

[Igor_123]

выделяешь диапазон данных для сортировки и идешь в меню Данные->Сортировка. Показываеться диалог в котором выбираешь по каким столбцам сортировать и в каком порядке.

после работы процедуры получаеться заполненный лист екселя. Вот Оставь в нем строк 50 данных, скопируй на другой лист и на другом листе переставь их так как нужно. и вышли

[abracadabra]

у меня в программе щас токо 4 параметра,
в аттаче файл - на листе 1 - все подряд, а на листе 2 - такие, приблизительно, как должны быть.