MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 15.06.2018, 16:23   #16
Nouba
MOF Guru
MOF Guru
Standard

@trekking,

für mein Verständnis wäre es ausreichend, eine examplarische Vereinfachung eines Einzelszenarios mit zwei bis drei Datensätzen auf der Einser-Seite und einigen Datensätzen auf der n-Seite jeweils mit zwei bis drei Feldern darzustellen. Es kann ja n-seitig entweder keinen, einen oder viele Datensätze geben. Wie ist das bei Dir? Wie stellst sich so ein Recordset in einem Excel-Blatt dar (grundsätzlich anfangs ohne Buntmalerei)? Bleiben die Zellen unter- und nebeneinander oder kommen da noch Freiräume hinzu? Mit welchen Methoden (Code) gelangen zur Zeit die Daten in ein Blatt?

Versuche einmal durch Zeitmessung herauszufinden, welche Aktionen die meiste Zeit verbraten. Die Art des oder der Recorsets dürfte vermutlich nicht das Nadelöhr sein.
Nouba ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 22:22   #17
trekking1
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Hallo Nouba,

Zeitmessungen sind einige gemacht worden. Die meiste Zeit geht beim "Tabellen" erstellen verloren. Da arbeite ich noch an einer Code - Optimierung. Ist aber sehr schwierig, da zuerst eine X Achse erstellt wird, dann eine y - Achse mit den füllenden Feldern der X - Achse. Dabei werden immer 3 Felder gemergt und dann mit Bounderies versehen. Teilweise auch eingefärbt oder noch mit ja/nein Kästchen versehen oder nur mit einem Kästchen und einem Begriff.

Je nachdem was erstellt wird, gibt es Kästchen, Einrückungen, Unterstriche, Ja//Nein Kästchen.

Auch die Höhe der Zeilen wird entsprechend angepasst. Die Befehle im einzelnen (IntCountRow und IntCountColumn sind Variablen):
Einfache Werte:
Code:

  With objWorksheet
    'Now Insert the Question Text. This will made by a merge of 6 cells and then insert the text
    .Range(.cells(My.ExcelBase.LastRow, lngLastCol + 1), .cells(My.ExcelBase.LastRow, lngLastCol + 6)).mergecells = True
    .cells(My.ExcelBase.LastRow, lngLastCol + 1).Value = QuestionSubText
    'Now set the font size and if the font is bold or not
    With .cells(My.ExcelBase.LastRow, lngLastCol + 1).Font
      .Name = "Arial"
      .Size = 15
      If QuestionSubTextBold = -1 Then
        .Bold = True
      Else
        .Bold = False
      End If
      .ColorIndex = RGB(0, 0, 0)
    End With
    'Set the hight of the row. The + is because we count e.g. 3 returns. So there exist 4 rows.
    .Rows(My.ExcelBase.LastRow).RowHeight = (My.Tools.ZeichenAnzahl(QuestionSubText, vbCrLf) + 1) * My.ExcelBase.RowStandardHeigth
    'Lock this row. This is necessary because the insert routine unlocks the merged cells.
    .Range(.cells(My.ExcelBase.LastRow, lngLastCol + 1), .cells(My.ExcelBase.LastRow, lngLastCol + 6)).locked = True
    'Now this is the end of the first line. The last Row is now LastRow + 1. The column is the same becuase it starts under the question
    My.ExcelBase.LastRow = My.ExcelBase.LastRow + 1
  End With
Checkboxen//Ja-Nein Boxen (2 x Checkbox)
Code:

  With objWorksheet
    'Insert a checkbox and bound it on the field.
    'First set the Position and dimension of the checkbox. The values are the field values were the checkbox should be
    chbLeft = .cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1).Left
    chbTop = .cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1).Top
    chbWidth = .cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1).Width
    chbHeight = .cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1).Height
    'Debug.Print chbWidth
    '.CheckBoxes.Add(chbLeft, chbTop, chbWidth, chbHeight).Select
    Set objCHB = .CheckBoxes.Add(chbLeft + chbWidth / 2 - 8, chbTop - chbHeight / 2 + 11, chbWidth / 2, chbHeight / 2 - 11)
      With objCHB
        .caption = "" 'No additional text is shown
        .Value = -4146  'Default value = false
        ''link the checkbox to the field where the checkbox is. (Not in Funktion. The checkbox get a unique name and it is possible to read it out)
        '.LinkedCell = objWorksheet.Cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1).Address(0, 0)
        'No 3D Shadow
        .Display3DShading = False
        .Name = "QSub_" & QuestionSubID
        '.Font.Size = 15
      End With
    Set objCHB = Nothing
Das ist alles Standard Excel-Code im einzelnen nichts besonderes in der Masse die an Daten verarbeitet wird aber sehr umfangreich. Der Code für die Tabellen ist zu umfangreich um ihn zu posten, er enthält aber im wesentliches nichts anderes als den für die einfachen Zellen.
Es gibt also je nachdem was der User will ein entsprechendes Ergebnis im Excel, Tabellenblatt das dann sehr komplex aussehen kann.

Der Code ist komplett aufgeteilt, damit er einfach wartbar ist. Die Objekte werden entsprechend übergeben, so dass auch kein Objekt-Chaos entsteht. In der Regel auch ordentlich geschlossen um den Speicerh wieder freizugeben.
Vom Datenmodell sind ca 14 Tabellen im Eingriff. Mehrere Ebenen werden dadurch dargestellt.

An einigen Stellen habe ich schon Verbesserungen erzielt und die Zeit deutlich reduziert. Jetzt komme ich eben in den Bereich wo es immer schwerer wird Zeiten zu minimieren. (90 - 10 Prinzip)
Einen großen Einfluss hat tatsächlich auch die Performance des Rechners. Das kann schon mal 30 Sekunden ausmachen. Oder die Netzwerkverbindung.
Was verbraucht eigentlich weniger Rechnerleistung Recordsets oder Arrays?

Eine Beispiel-DB kannichnciht posten, das ist vom Auftraggeber nicht erlaubt.
Hoffe das gibt Dir einen besseren Einblick. Vielleicht hast Du ja eine Idee was noch helfen könnte.

Vielen Dank und viele Grüße
trekking
trekking1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.06.2018, 08:44   #18
CatboyJones
MOF User
MOF User
Standard

Ich glaube, ich würde das so schreiben:

Code:

  With objWorksheet
    With .Cells(My.ExcelBase.LastRow, lngLastCol + 1)
      .Value = QuestionSubText
      With .Font
        .Name = "Arial"
        .Size = 15
        .Bold = QuestionSubTextBold
        .ColorIndex = 0
      End With
    End With
    With .Range(.Cells(My.ExcelBase.LastRow, lngLastCol + 1), .Cells(My.ExcelBase.LastRow, lngLastCol + 6))
      .MergeCells = True
      .Locked = True
    End With
    .Rows(My.ExcelBase.LastRow).RowHeight = (My.Tools.ZeichenAnzahl(QuestionSubText, vbCrLf) + 1) * My.ExcelBase.RowStandardHeigth
  End With
  My.ExcelBase.LastRow = My.ExcelBase.LastRow + 1
Code:

  With objWorksheet
    With .Cells(My.ExcelBase.LastRow, My.ExcelBase.LastColumn + 1)
      chbLeft = .Left
      chbTop = .Top
      chbWidth = .Width
      chbHeight = .Height
    End With
      With .Checkboxes.Add(chbLeft + chbWidth / 2 - 8, chbTop - chbHeight / 2 + 11, chbWidth / 2, chbHeight / 2 - 11)
        .Caption = ""
        .Value = -4146
        .Display3DShading = False
        .Name = "QSub_" & QuestionSubID
        '.Font.Size = 15
      End With

Gruss
Jones
CatboyJones ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.06.2018, 09:30   #19
Nouba
MOF Guru
MOF Guru
Standard

Zeilenweise das Blatt zu beschreiben, tendiert zu Trägheit. Ich würde versuchen, die Daten schon so anzuordnen, dass sie zumindest blockweise in einem Range bearbeitet und formatiert werden können. Range in den Speicher holen, bearbeiten und dann erst dem Blatt ieder zuweisen.
Code:

|-------+---------+--------------|
| Frage | Antwort | Unterantwort |
|-------+---------+--------------|
| F1    | F1_A1   |              |
|       | F1_A2   |              |
|       | F1_A3   |              |
|       | F1_A4   |              |
|       | F1_A5   |              |
|       | F1_A6   |              |
|-------+---------+--------------|
| F2    | F2_A1   | F2_A1_U1     |
|       |         | F2_A1_U2     |
|       | F2_A2   | F2_A2_U1     |
|       |         | F2_A2_U2     |
|       |         | F2_A2_U3     |
|-------+---------+--------------|
Bei variierender Blockgröße kann man die Anzahl der Folgeelemente ja im Datensatzvermerken, was bei konstanten 6 Antworten natürlich nicht notwendig ist.

Und natürlich Excel während des Prozederes ausblenden.

PS: Eventuell kann man durch die Verwendung einer Vorlage weitere Zeit einsparen.
Nouba ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.06.2018, 10:11   #20
trekking1
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

@CatBoy

Zitat:

.Bold = QuestionSubTextBold

Oh Mann Du hast recht an der Stelle. Wald und Bäume

Den Merge nach dem einfügen des Wertes zu machen hatte nicht funktioniert. Weiß allerdings nicht mehr genau was da passierte. Ist einfach schon etwas länger her.
Die Zusammenfassungen gefallen mir gut. With ist ja immer zu bevorzugen.
Zu meiner Verteidigung muss ich sagen, dass ich oft den Code erstmal schreibe, dass er funktioniert und im laufe der Zeit immer mehr zusammenfasse oder in eigene Funktionen//Subs auslagere. Dies soll allerdings nicht den Wert Deines Tips für mich schmälern

@Nouba
Das hört sich interessant an. Danke für die Idee.
Kannst Du mir da noch etwas auf die Sprünge helfen wie genau das ablaufen kann. Bin mir noch nicht ganz sicher ob ich da ganz bei Dir bin. Also ich "eröffne" ein Range Objekt. Diesem Weise ich die einzelnen Zeilen zu die ich entsprechend formatiere. Dieses Objekt weise ich dann dem Tabellenblatt als Ganzes zu. Richtig?

Zitat:

Und natürlich Excel während des Prozederes ausblenden.

Alles ausgeschaltet
Code:

  With My.Excel.ExcelApp
    '.visible = True  'Only for finding Errors
    .DisplayStatusBar = False
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = -4135 'Means Calculation manual
  End With

Zitat:

Eventuell kann man durch die Verwendung einer Vorlage weitere Zeit einsparen.

Hatte ich in einem anderen Excel workbook gemacht. die Vorlagen dann entsprechend kopiert oder die "Standardzeile" komplett als Vorlage drin und dann enstprechend Zeilen eingefügt. Hatte nicht soviel gebracht wie erhofft.
Für das nennen wir es mal Hauptexcel-Problem ist das nicht möglich, da es praktisch keine identischen Blöcke gibt.

Danke für eure Unterstützung. Ich weiß schon warum mir diese Forum am besten gefällt. Es gibt hier einfach viele gute Leute mit guten Ideen

Viele Grüße
trekking
trekking1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.06.2018, 07:48   #21
Nouba
MOF Guru
MOF Guru
Standard

Hi trekking,

hier ein grobes Schema, wie ich das in etwa angehen würde.
Code:

Private Function GetSampleData()

   Const adUseClient  As Long = 3
   Const adOpenStatic As Long = 3
   Const adVarWChar   As Long = 202

   Dim i&, j&, k&

   Set GetSampleData = CreateObject("ADODB.Recordset")
   With GetSampleData
      With .Fields
         .Append "Frage", adVarWChar, 20
         .Append "Antwort", adVarWChar, 40
         .Append "Unterantwort", adVarWChar, 40
      End With
      
      .CursorLocation = adUseClient
      .CursorType = adOpenStatic
      .Open

      Randomize 4711

      For i = 1 To Int(Rnd() * 20) + 51
         For j = 1 To Int(Rnd() * 6) + 1
            For k = 1 To Int(Rnd() * 5) + 1
               .AddNew Array("Frage", "Antwort", "Unterantwort"), _
                       Array("Frage " & i, _
                             "Antwort " & i & "." & j, _
                             "Unterantwort " & i & "." & j & "." & k)
      Next k, j, i
   End With
End Function

Sub TestTestXlAutomation()

   Const xlEdgeLeft         As Long = 7
   Const xlEdgeTop          As Long = 8
   Const xlEdgeBottom       As Long = 9
   Const xlEdgeRight        As Long = 10
   Const xlInsideVertical   As Long = 11
   Const xlInsideHorizontal As Long = 12

   Const xlContinuous       As Long = 1
   Const xlThin             As Long = 2
   Const xlAutomatic        As Long = -4105

   Const xlCenter           As Long = -4108

   Dim wb, ws, rs, rg
   Dim i&, j&, numrows&

   Set wb = CreateObject("Excel.Application").Workbooks.Add()
   Set ws = wb.Worksheets(1)
   Set rs = GetSampleData()
   Set rg = ws.Range("A1:C1")
   rg.Value2 = Array(rs(0).Name, rs(1).Name, rs(2).Name)
   numrows = rg.Offset(1).CopyFromRecordset(rs)
   rs.Close

   Set rg = ws.Range("A2", ws.Cells(numrows + 1, 3))

   i = 1
   Do While i < numrows
      j = 0
      Do While rg.Cells(i + j, 1) = rg.Cells(i + j + 1, 1)
         j = j + 1
      Loop

      If j > 0 Then
         rg.Cells(i + 1, 1).Resize(j).ClearContents
         rg.Cells(i, 1).Resize(j + 1).MergeCells = True
         rg.Cells(i, 1).VerticalAlignment = xlCenter
      End If

      i = i + j + 1
   Loop

   With rg.Cells(1, 1).Resize(numrows).Font
      .Name = "Arial"
      .Size = 15
      .Bold = True
   End With

   i = 1
   Do While i < numrows
      j = 0
      Do While rg.Cells(i + j, 2) = rg.Cells(i + j + 1, 2)
         j = j + 1
      Loop

      If j > 0 Then
         rg.Cells(i + 1, 2).Resize(j).ClearContents
         rg.Cells(i, 2).Resize(j + 1).MergeCells = True
         rg.Cells(i, 2).VerticalAlignment = xlCenter
      End If

      i = i + j + 1
   Loop

   With rg.Cells(1, 2).Resize(numrows).Font
      .Name = "Arial"
      .Size = 12
      .Bold = True
   End With

   With rg.Cells(1, 3).Resize(numrows).Font
      .Name = "Arial"
      .Size = 10
   End With

   For i = xlEdgeLeft To xlInsideHorizontal
      With rg.Offset(-1, 0).Resize(numrows + 1).Borders(i)
         .LineStyle = xlContinuous
         .ColorIndex = xlAutomatic
         .TintAndShade = -0.349986266670736
         .Weight = xlThin
      End With
   Next

   rg.Offset(-1, 0).Resize(numrows + 1).Columns.AutoFit
   rg.Offset(-1, 0).Resize(numrows + 1).Rows.AutoFit

   wb.Application.Windows(1).Visible = True
   wb.Application.Visible = True

End Sub
PS: wenn der Benutzer zum Zeitpunkt des Erstellens des Blatts auch anderweitig sinnvoll mit der Anwendung arbeiten kann und sich die Erstellungszeit nicht wesentlich reduzieren lässt, könnte man auch ein VBScript für den Zweck schreiben und als eigenständigen Prozess starten.

Geändert von Nouba (17.06.2018 um 08:17 Uhr). Grund: PS hinzugefügt
Nouba ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.06.2018, 11:05   #22
trekking1
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

@Nouba

Super interessanter Ansatz. Danke dafür.
Werde mich jetz mal damit beschäftigen und herausfinden was ich wie an welcher Stelle benutzen kann. Gerade mit den Tabellen, die die Hauptprobleme verursachen, könnte das so echt klappen.

Wird aber etwas dauern, da die Performance Verbersserung jetzt erst wieder Mitte Ende Juli ansteht. Allerdings arbeite ich immer wieder etwas daran wenn ich Zeit habe.

Werde Dir auf alle Fälle ein entsprechendes Feedback zukommen lassen.

Zum PS: Da gab es auch die Idee, dass wir eine Access DB auf einem Server laufen lassen und diese dann mithilfe eines Timers immer nachsieht ob ein Job zum erstellen eines Excel Workbooks vorhanden ist. Nach dem erstellen wird es entsprechend gespeichert und der USer erhält eine Mail mit dem Hinweis, dass sein Projekt nun bearbeitet werden kann.

Nochmals vielen Dank und liebe Grüße

trekking

Geändert von trekking1 (17.06.2018 um 11:11 Uhr).
trekking1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:26 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.