VBA Code abändern - ohne Hilfstabelle ?

[Steffl]

Hallo Angelina,

habe wohl zuviel gelöscht :22:

Code:

Option Explicit
Option Base 1

Sub Zuordnen()
   Dim wksGruppen As Worksheet
   Dim rngSrc As Range, 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

[Rabe]

Hi,

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

nee, ob sie überhaupt angelegt sind.

[Angelina]

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!

hallo,

dein VBCode hat mir den Abend gerettet - das erste was heute funktioniert hat - bei mir

So wenig VBCode und ruckzuck standen die Zahlen da!

:23:

Du bist mein Tagesheld :28:

Danke dir - nochmals

LG
Angelina

[Angelina]

Hi,

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

nee, ob sie überhaupt angelegt sind.

hallo Ralf,

ob sie überhaupt angelegt sind?

Wie wo - bin überfragt - :22:

Erkläre es mir bitte

Gruß
Angelina

[atilla]

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.

Hallo Angelina,

Dir fehlen Grundkenntnisse, deswegen konntest Du Deine Code in einer anderen Mappe nicht nutzen.

1. in Deiner eingestellten Mappe sind die gelb hinterlegten Bereiche in 8 Bereiche unterteilt und sind mit Namen definiert im Namensmanager zu finden.
2. Dein Code greift genau auf die Bereiche zu. In einer neuen Mappe müsstest Du diese Bereiche erst definieren. Hier Bereichsnamen hat Andre erklärt, wie das geht.

Auf diese Umstände hat Ralf versucht Dich hinzuweisen. Dann hat Ralf noch etwas entscheidendes geschrieben:

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

Das heißt Du fügst im VBA Editor ein Allgemeines Modul ein, und fügst Deinen Code da rein.
Wichtig ist, dass der Code dann mit: Call Zuordnen aufgerufen wird.

Der Code ist an sich nicht langsam und funktioniert auch richtig. Er benötigt natürlich die definierten Bereiche. Das kann von Vorteil sein, wenn zum Beispiel Zeilen oder Spalten eingefügt werden. Dann brauchst Du am Code keine Anpassungen vornehmen.

Schau Dich auch mal auf folgender Seite um, da findest Du auch so einige Erklärungen zu Makros und VBA

@Edgar
hallo Edgar, muss das wirklich sein., dass Du Deine Formelmacht jetzt auch in VBA ausspielst.
Aber klasse Lösung, muss ich neidlos (eigentlich doch neidisch :@) anerkennen

[Angelina]

hallo Atilla,

danke auch dir für die Rückmeldung.

Auf diese Umstände hat Ralf versucht Dich hinzuweisen.

"Bereichsnamen" - das ist mir in der Tat neu - lese ich mir morgen durch.

Das heißt Du fügst im VBA Editor ein Allgemeines Modul ein, und fügst Deinen Code da rein.
Wichtig ist, dass der Code dann mit: Call Zuordnen aufgerufen wird.

Das habe ich ja gemacht - aber wenn der Bereichsname nicht von mir angelegt ist, dann konnte es ja nicht gehen.
Ich habe heute einiges gelernt.

4 Stunden suchen - und dann kann es so einfach sein.
Nichts gegessen - meine Bacon 1 und Bacon 2 sind geschrupft :84:


Danke an alle die mir hier sehr geholfen haben - ihr seid alle soooooooo lieeeeeeeb

Danke euch - nochmals

Danke Ralf - Edgar - Stefan - Atilla

LG
Angelina

[BoskoBiati]

Hallo Atilla,

mit benannten Bereichen ist das Ganze ja noch einfacher, aber darauf habe ich gar nicht geachtet.

Code:

Sub Zuordnen()
   Dim loZahl As Long
   Dim rng As Range
   Dim loCo As Double
  
   Application.ScreenUpdating = False
   For loZahl = 1 To 8
        
        Set rng = Range("Src_0" & loZahl)
        For loCo = 0 To 5
            Cells(34 + loZahl, 64 + loCo) = WorksheetFunction.Large(rng, 6 - loCo)
        Next
   Next
   Application.ScreenUpdating = True
  
End Sub