Zellinhalte mehrerer Bereiche an weitere Stelle Kopieren und Sortieren

Question

Hallo,

Ich habe mit Hilfe von Zellrahmen Formatierung den Grundriss unserer
Firmenhallen erstellt.
Und mit Nummer & Kunde 'Maschinen' in der 'Halle' verteilt.
Bisher kopiere ich die jeweiligen Zellinhalte manuell und liste sie aus Platzgründen
zweireihig auf.

Was aber Zeitaufwändig und Fehleranfällig ist.

Bisher Sortiere ich die Werte aufsteigend.
Lieber wäre mir aber die Werte nach ihren letzten 4 Ziffern ebenfalls aufsteigend zu
sortieren.

Ich würde gerne zwei Bereiche angeben z.B. (M47:BU61 & AW2:BU46)
Und alle Zelleninhalte die dort mit mindestens 4 Zahlen beginnen in Spalte A (I2 bis
I26 und AD2 bis AD26) anzeigen und Kopieren lassen.

Nur einige wenige Zellen haben einen Inhalt
Nicht alle Zellwerte beginnen mit einer Zahl

Hilfsspalten oder Zeilen wären kein Problem da ich immer nur die erste Seite
Drucke

Hat jemand eine Idee

Gruß
Manuel

Answer 1

Hallo Manuel,

das könnte man wohl am einfachsten mit einem Makro lösen.

Und alle Zelleninhalte die dort mit mindestens 4 Zahlen beginnen in Spalte A (I2 bis I26 und AD2 bis AD26) anzeigen und Kopieren lassen.

Sollen die Daten nun in Spalte A oder in die Bereiche I2 bis I26 und AD2 bis AD26 kopiert werden?

Und wenn du eventuell mal eine Beispieldatei mit ein paar Dummydaten auf einen Hoster deiner Wahl hochladen könntest und den Link dann hier postest, wäre es noch einfacher dir zu helfen.

Gruß

M.O.

Answer 2

Hallo M.O.,

Nach momentanen Layout sollten die 'Maschinen' im Bereich I2 bis
I26 und AD2 bis AD26 aufgelistet werden.

Hier mal Dateien.
EInmal als PDF und einmal das Konstrukt in Excel

PDF
src=http://www.filedropper.com/download_button.png width=127
height=145 border=0/></a><br /><div style=font-size:9px;font-
family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;>
<a href=http://www.filedropper.com >online backup storage</a>
</div>"><a href=http://www.filedropper.com/hallenlayoutdi><img
src=http://www.filedropper.com/download_button.png width=127
height=145 border=0/></a><br /><div style=font-size:9px;font-
family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;>
<a href=http://www.filedropper.com >online backup storage</a>
</div>

.xlsx
src=http://www.filedropper.com/download_button.png width=127
height=145 border=0/></a><br /><div style=font-size:9px;font-
family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;>
<a href=http://www.filedropper.com >file upload storage</a></div>
"><a href=http://www.filedropper.com/hallenlayoutdl_1><img
src=http://www.filedropper.com/download_button.png width=127
height=145 border=0/></a><br /><div style=font-size:9px;font-
family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;>
<a href=http://www.filedropper.com >file upload storage</a></div>


Gruß

Manuel[url]

Answer 3

Hallo Manuel,

ich werde mir das mal anschauen.

Gruß

M.O.

Answer 4

Wenn ich es jetzt noch schaffen würde die hochgeladenen Dateien
zugänglich zu machen.

.xlsx
PDF

Wer lesen kann ich klar im Vorteil.
Und erst wer schreiben kann...

Das A gehörte da nicht hin.
;-)

Answer 5

Vielen Dank schon mal :-)

Answer 6

Hallo,

ich habe gesehen, dass du in einer Zelle AE59 verbundene Zellen hast, in denen zwei Nummern stehen. Ich würde diese verbundenen Zellen auflösen und die beiden Nummern in jeweils eigene Zellen schreiben, da sie sonst vom Makro nicht als eigenständige Nummern erkannt werden.

Hier mal ein Code, der in ein Standard-Modul deiner Arbeitsmappe gehört:

Sub Daten_sammeln()
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Gesamtbereich As Range
Dim rngZelle As Range
Dim lngZeile As Long
Dim i As Long
Dim lngEZeile As Long
Dim lngESpalte As Long
Dim vX As Variant

'Zähler für Einfügezeile
lngZeile = 8

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

With ActiveSheet

'Bereiche definieren und zusammenfassen
Set Bereich1 = .Range("G31:AV61")
Set Bereich2 = .Range("AW2:BU61")
Set Gesamtbereich = Union(Bereich1, Bereich2)

'Zellen im Bereich durchlaufen
For Each rngZelle In Gesamtbereich
If IsEmpty(rngZelle) = False Then
'gefundene Daten nach Spalte BY kopieren, ab Zeile 8
If IsNumeric(Left(rngZelle.Value, 4)) Then
.Cells(lngZeile, 77) = rngZelle.Value
'Zellinhalt aufsplitten nach Leerzeichen
vX = Split(rngZelle.Value, " ")
'letzte 4 Ziffern der Zahl - Teil 1 des Strings - in Spalte BZ schreiben
.Cells(lngZeile, 78) = Right(vX(0), 4)
lngZeile = lngZeile + 1
End If
End If
Next rngZelle

End With

'Sortieren
With ActiveWorkbook.ActiveSheet
Set Bereich1 = .Range(.Cells(8, 77), .Cells(lngZeile - 1, 78)) 'Sortierbereich definieren
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(8, 78), .Cells(lngZeile - 1, 78)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Bereich1
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Bereiche I2 bis I26 und AD2 bis A 26 löschen
.Range("I2:I26").ClearContents
.Range("AD2:AD26").ClearContents

'sortierte Daten in Bereich schreiben
'erste Einfügezeile und -spalte festlegen
lngEZeile = 1
lngESpalte = 9

For i = 8 To lngZeile - 1
lngEZeile = lngEZeile + 1
If lngEZeile = 27 Then
lngEZeile = 2
lngESpalte = 30
End If
.Cells(lngEZeile, lngESpalte) = .Cells(i, 77)
Next i

'Hilfsspalten für das Sortieren löschen
.Range(.Cells(8, 77), .Cells(lngZeile - 1, 78)).ClearContents

End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True


End Sub

Und hier die bearbeitete Datei:
KLICK MICH!

Gruß

M.O.

Answer 7

Hi M.O. ,

vielen vielen Dank für die Mühen.
Das sieht ja richtig nach Arbeit aus.
Aber funktioniert Eins A.

Ich hab mal noch nen ‚Knopf‘ dran gebastelt und im Hinterkopf vermerkt jeweils nur eine Maschinen Nummer pro Zelle zu ‚malen‘.

Ach ja, und den Code in ‚Tabelle1‘ verschoben.:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$Z$29" Then Call Daten_sammeln
End Sub


Sub Daten_sammeln()
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Gesamtbereich As Range
Dim rngZelle As Range
Dim lngZeile As Long
Dim i As Long
Dim lngEZeile As Long
Dim lngESpalte As Long
Dim vX As Variant

'Zähler für Einfügezeile
lngZeile = 8

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

With ActiveSheet

'Bereiche definieren und zusammenfassen
Set Bereich1 = .Range("G31:AV61")
Set Bereich2 = .Range("AW2:BU61")
Set Gesamtbereich = Union(Bereich1, Bereich2)

'Zellen im Bereich durchlaufen
For Each rngZelle In Gesamtbereich
If IsEmpty(rngZelle) = False Then
'gefundene Daten nach Spalte BY kopieren, ab Zeile 8
If IsNumeric(Left(rngZelle.Value, 4)) Then
.Cells(lngZeile, 77) = rngZelle.Value
'Zellinhalt aufsplitten nach Leerzeichen
vX = Split(rngZelle.Value, " ")
'letzte 4 Ziffern der Zahl - Teil 1 des Strings - in Spalte BZ schreiben
.Cells(lngZeile, 78) = Right(vX(0), 4)
lngZeile = lngZeile + 1
End If
End If
Next rngZelle

End With

'Sortieren
With ActiveWorkbook.ActiveSheet
Set Bereich1 = .Range(.Cells(8, 77), .Cells(lngZeile - 1, 78)) 'Sortierbereich definieren
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(8, 78), .Cells(lngZeile - 1, 78)), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
With .Sort
.SetRange Bereich1
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Bereiche I2 bis I26 und AD2 bis A 26 löschen
.Range("I2:I26").ClearContents
.Range("AD2:AD26").ClearContents

'sortierte Daten in Bereich schreiben
'erste Einfügezeile und -spalte festlegen
lngEZeile = 1
lngESpalte = 9

For i = 8 To lngZeile - 1
lngEZeile = lngEZeile + 1
If lngEZeile = 27 Then
lngEZeile = 2
lngESpalte = 30
End If
.Cells(lngEZeile, lngESpalte) = .Cells(i, 77)
Next i

'Hilfsspalten für das Sortieren löschen
.Range(.Cells(8, 77), .Cells(lngZeile - 1, 78)).ClearContents

End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True


End Sub

Bin neidisch,
wo kann ich das Lernen.

Answer 8

Hallo,

freut mich, dass das Makro so funktioniert, wie du dir das vorgestellt hast.
Was ich noch vergessen hatte zu schreiben: Die Daten werden in die Spalten BY und BZ ab Zeile 8 eingefügt, dort sortiert und dann gelöscht.
Dort also bitte nichts eintragen.

Ich habe mir VBA über die Jahre selbst beigebracht und z.B. hier entsprechende Threads gelesen. Außerdem gibt es im Internet viele Seiten, die sich mit VBA für Excel befassen, z.B. hier. Du kannst natürlich auch einen Kurs belegen, z.B. an einer Volkshochschule.

Gruß

M.O.

Answer 9

Hi,
und Danke nochmal für den letzten Tipp.

Ich hätte da noch ne Bitte.

Kann man noch eine Art Bedingte Formatierung integrieren?.
Nachdem ich das Makro nun intensiv genutzt hab ist mir aufgefallen das es mir öfter Vorkommt das ich Maschinen Nummern doppelt notiere, weil
Maschinen verschoben wurden.
Super wäre also wenn (Links...;6) die ersten 6 Ziffern verglichen würden und bei Duplikaten die Einträge farblich markiert würden. So das man auf
einen Blick erkennen könnte das etwas im argen liegt. Sinnvoll scheint mir die Markierung im 'Hallenbereich' zu sein oder auch zusätzlich in der
Auflistung. Nur in der Auflistung wäre nicht die günstigste Lösung. ;-(


Ist das möglich?