VBA Code abändern - ohne Hilfstabelle ?

[Angelina]

hallo

ich habe hier ein VBACode der eine Gruppenverteilung vornimmt.

Derzeit wird eine Hilfstabelle verwendet und auch sonst läuft dieser nicht so perfekt.

Würde mich freuen, wenn jemand Zeit hätte um sich das mal anzusehen und mir helfen
könnte.

Gruß
Angelina

[Rabe]

Hi Angelina,

ich habe ich ein VBACode der eine Gruppenverteilung vornimmt.

Derzeit wird eine Hilfstabelle verwendet und auch sonst läuft dieser nicht so perfekt.

Würde mich freuen, wenn jemand Zeit hätte um sich das mal anzusehen und mir helfen
könnte.

zu Deinem ersten Problem:
Verschiebe den Code von hinter "DieseArbeitsmappe" in ein allgemeines Modul

zum zweiten
Ändere den Code hinter dem CommandButton1 so:

Option Explicit

Private Sub CommandButton1_Click()
   'DieseArbeitsmappe.Zuordnen 
   Call Zuordnen
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 14

Wie das Makro funktioniert, habe ich mir noch nicht angeschaut (nur getestet, ob) und wie es jetzt ohne Hilfstabelle gelöst werden könnte, habe ich deswegen noch keine Idee. Evtl. könnte das über Arrays klappen, aber da ist atilla (mal wieder :30) der Erfahrenere oder auch André (schauan).

Aber so wie jetzt arbeitet das Makro doch einwandfrei und sehr schnell.
Warum willst Du keine Hilfstabelle verwenden?

[Angelina]

hallo Rabe,

zu Deinem ersten Problem:
Verschiebe den Code von hinter "DieseArbeitsmappe" in ein allgemeines Modul

Habe ich heute alles leider schon probiert - geht alles nicht - es werden keine Daten eingetragen.
4 Stunden heute getestet - ich verstehe das nicht.
Die Beispiel-Mappe von mir läuft sehr gut - aber sobald ich es in ein bestehendes Projekt einbinden
möchte und per Call aufrufe - geht es nicht mehr.

Aber so wie jetzt arbeitet das Makro doch einwandfrei und sehr schnell.
Warum willst Du keine Hilfstabelle verwenden?

Sorry - aber ich kann diesen VBCode nicht mehr sehen. Vielleicht liegt es an den 4 Stunden!

Gruß
Angelina

[Rabe]

Habe ich heute alles leider schon probiert - geht alles nicht - es werden keine Daten eingetragen.
4 Stunden heute getestet - ich verstehe das nicht.
Die Beispiel-Mappe von mir läuft sehr gut - aber sobald ich es in ein bestehendes Projekt einbinden
möchte und per Call aufrufe - geht es nicht mehr.

Du kannst mir Dein bestehendes Projekt auch mal per Mail zuschicken. Meine Adresse ist in meinem Profil. Vielleicht kriege ich es hin.

Verstehe ich das richtig:
Du hast im bestehenden Projekt in "DieseArbeitsmappe" ein Makro, das funktioniert. Dies willst Du nun per Call aufrufen und dann geht es nicht mehr? Was heißt "es geht nicht mehr"?

Oder verwendest Du das Makro aus der Beispiel-Mappe in deinem Projekt? Sind die beiden Dateien wirklich gleich aufgebaut? Sonst wird das Makro ja nicht auf die richtigen Zellen zugreifen.

[Angelina]

hallo Ralf,

Oder verwendest Du das Makro aus der Beispiel-Mappe in deinem Projekt? Sind die beiden Dateien wirklich gleich aufgebaut? Sonst wird das Makro ja nicht auf die richtigen Zellen zugreifen.

Ich wollte genau dieses Makro aus dieser Beispiel-Mappe in mein Projekt einbinden.

1. Ich habe in meinem Projekt eine Hilfstabelle angelegt
2. Ich habe den VBCode aus der Beispiel-Mappe in meinem Projekt "DieseArbeitsmappe" 1:1 eingefügt
3. Nun habe ich versucht über:
Call DieseArbeitsmappe.Zuordnen
dieses Makro auszuführen. Es läuft ohne Fehlermeldung durch - jedoch werden keine Daten
in den Bereich BL35:BQ42 geschrieben. Ebenso sind in der Hilfstabelle keine Einträge vorhanden.

Ein Stop unterhalb von
With wksGruppen
unterbricht hier das Makro

mache ich jedoch ein Stop unterhalb von
Next c

dann stopt das Makro nicht mehr

Ich komme einfach nicht weiter

Gruß
Angelina

[BoskoBiati]

Hallo,

hier ein Makro in einem externen Modul:

Code:

Sub Zuordnen()
   Dim loZahl As Long
   Dim rng As Range
   Dim loAdd As Long
   Dim loCo As Double
  
   Application.ScreenUpdating = False

   For loZahl = 1 To 8
        If loZahl > 2 Then loAdd = 4
        If loZahl > 4 Then loAdd = 20
        If loZahl > 6 Then loAdd = 24
        Set rng = Range(Cells(3 + loAdd, 80 + ((loZahl - 1) Mod 2) * 3), Cells(6 + loAdd, 82 + ((loZahl - 1) Mod 2) * 3))
        For loCo = 0 To 5
            Cells(34 + loZahl, 64 + loCo) = WorksheetFunction.Large(rng, 6 - loCo)
        Next
   Next
   Application.ScreenUpdating = True
End Sub

Nicht vergessen: Das Makro zum CommandButton muß geändert werden, "DieseArbeitsmappe." muß weg!

[Rabe]

Hi Angelina,

Call DieseArbeitsmappe.Zuordnen
dieses Makro auszuführen. Es läuft ohne Fehlermeldung durch - jedoch werden keine Daten
in den Bereich BL35:BQ42 geschrieben. Ebenso sind in der Hilfstabelle keine Einträge vorhanden.

Die benannten Bereiche Src_01 bis 08 sind aber in der richtigen Datei schon ebenfalls definiert?
Die Arbeits-Tabelle heißt ebenfalls "Forecast" und die Hilfstabelle heißt auch "Hilfstabelle"?

[Steffl]

Hallo Angelina,

dann gibt es vermutlich innerhalb der For Each-Schleife einen Fehler und es greift das Error-Handling. Solange sowas nicht 100% funktioniert sollte Du die Fehlerbehandlung ausschalten. Es kann da auch keine Meldung erscheinen, denn Du schaltest nur die Berechnung und die Bildschirmaktualisierung wieder ein. Ich habe aber einen Lösungsvorschlag ohne Übertrag in die Hilfstabelle. IMHO gehört der Code in ein allgemeines Modul.

Code:

Option Explicit
Option Base 1

Sub Zuordnen()
   Dim wksGruppen As Worksheet
   Dim c As Range
   Dim Grp As Integer, z As Integer
   Dim aData(6)
  
   On Error GoTo ErrorHandler
   With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
   End With
   Set wksGruppen = Sheets("Forecast")
   With wksGruppen
      For Grp = 1 To 8
         z = 0
         Set rngSrc = .Range("Src_" & Format(Grp, "00"))
         For Each c In rngSrc
            If c.Value > "" Then
               z = z + 1
               aData(z) = c.Value
            End If
         Next c
         QuickSort_Feld aData, 1, 6, False
         .Cells(34 + Grp, 64).Resize(, 6) = aData
         '------------------
      Next Grp
   End With
'   wksGruppen.Activate
ErrorHandler:
   With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
   End With
End Sub

Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, _
Absteigend As Boolean)
'QuickSort Standard
'von Peter Haserodt, online-excel.de
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
  If Not Absteigend Then
   While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
    iUnten = iUnten + 1
   Wend
   While (iMitte < DasFeld(iOben) And iOben > StartUnten)
    iOben = iOben - 1
   Wend
  Else
   While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
    iUnten = iUnten + 1
   Wend
   While (iMitte > DasFeld(iOben) And iOben > StartUnten)
    iOben = iOben - 1
   Wend
  End If
  If (iUnten <= iOben) Then
   y = DasFeld(iUnten)
   DasFeld(iUnten) = DasFeld(iOben)
   DasFeld(iOben) = y
   iUnten = iUnten + 1
   iOben = iOben - 1
  End If
Wend
If (StartUnten < iOben) Then Call _
QuickSort_Feld(DasFeld, StartUnten, iOben, Absteigend)
  If (iUnten < EndeOben) Then Call _
QuickSort_Feld(DasFeld, iUnten, EndeOben, Absteigend)
End Sub

Nachtrag: Überflüssige Variablendekleration und Zuweisung aus dem Code entfernt.

[Angelina]

hallo,

@ Steffl
erstmal danke für dein Hilfsangebot - habe gleich getestet:

Variable nicht definiert
rngSrc =


@ Ralf

Die Arbeits-Tabelle heißt ebenfalls "Forecast" und die Hilfstabelle heißt auch "Hilfstabelle"?

Ja

Die benannten Bereiche Src_01 bis 08 sind aber in der richtigen Datei schon ebenfalls definiert?

Hm.... meinst du ob die 1:1 optisch so angelegt sind?
Optisch 1:1

Gruß
Angelina

[BoskoBiati]

Hallo,

ich dachte Du wolltest ohne Hilfstabelle arbeiten? Mein Code macht das.