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
Hi,
(02.02.2015, 19:56)Angelina schrieb: [ -> ]Hm.... meinst du ob die 1:1 optisch so angelegt sind?
Optisch 1:1
nee, ob sie überhaupt angelegt sind.
(02.02.2015, 19:33)BoskoBiati schrieb: [ -> ]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
(02.02.2015, 20:12)Rabe schrieb: [ -> ]Hi,
(02.02.2015, 19:56)Angelina schrieb: [ -> ]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
(02.02.2015, 19:30)Angelina schrieb: [ -> ]hallo Ralf,
Zitat: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:
(02.02.2015, 17:15)Rabe schrieb: [ -> ]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
hallo Atilla,
danke auch dir für die Rückmeldung.
Zitat:Auf diese Umstände hat Ralf versucht Dich hinzuweisen.
"Bereichsnamen" - das ist mir in der Tat neu - lese ich mir morgen durch.
Zitat: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
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