Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Bereiche nach Wert sortieren

Bereiche nach Wert sortieren
wothan
Hallo Ihr Lieben
Folgendes Problemchen
In den Spalte stehen: cat;titel ;code;notiz
cat1- a- 2- aa
------ x- 2- xx
------ f- 3- ff

cat2- b- -- bb
------ z- 3- zz
------ c- -- cc
cat3- d- -- dd
------ l- -- ll
------ m- -- mm
cat4- p- 4- pp
------ o- 4- oo
------ e- -- ee

cat5- k- -- kk
------ i- -- ii
------ q- -- qq
Diese Werte sollen jetzt so geordnet werden das jeweils in einer cat keine doppelwerte in der mittleren Spalte stehen, getauscht werden darf aber nur mit der jeweiligen nachbar cat(cat1 mit cat2 ; cat3 mit cat2 oder cat4;usw). dabei müssen die nachbar zellen erhalten bleiben,cat muss unverändert bleiben. Was ich da geschrieben habe schaut 1. sch..... aus und funktioniert nur bis auf leere zellen gelaufen wird.
Dim lngRow As Integer
Dim rh
Worksheets("Tabelle1").Select
For lngRow = 1 To 30 Step 3
If Cells(lngRow + 1, 8).Value = Cells(lngRow + 2, 8).Value And Cells(lngRow + 2, 8).Value '> 0 _
Or Cells(lngRow + 1, 8).Value = Cells(lngRow + 3, 8).Value And Cells(lngRow + 3, 8).Value '> 0 _
Or Cells(lngRow + 2, 8).Value = Cells(lngRow + 3, 8).Value And Cells(lngRow + 3, 8).Value '> 0 Then
For rh = 6 To 8
Cells(lngRow + 1, rh + 1).Cut
Cells(lngRow + 5, rh + 1).Insert Shift:=xlDown
Next rh
End If
Next lngRow
End Sub
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Beispieldatei
15.08.2009 11:39:27
Daniel
Hi
hilfreich wäre ne Beispieldatei, wo du darstellst, wie die Daten ursprünglich sind und wie sie nach dem Makrolauf aussehen sollen.
deine bisherigen Makroversuche wären auch hilfreich.
Gruß, Daniel
AW: Beispieldatei
15.08.2009 14:15:12
wothan
Serus Daniel
Mein Makroversuch ist ja wohl dabei und das nötige Beispiel hab ich leider in einem neuen Beitrag erscheinen lassen, siehe "Bild hierzu gefunden"
-wothan--
Anzeige
AW: Bereiche nach Wert sortieren
15.08.2009 14:49:17
wothan
komme der Sache schon etwas näher,aber noch nicht das Wahre:
Dim rh
Dim lngRow As Integer
Worksheets("Tabelle1").Select
For lngRow = 1 To 30 Step 3
For rh = 6 To 8
If Cells(lngRow + 1, 8).Value = Cells(lngRow + 2, 8).Value And Cells(lngRow + 2, 8).Value > 0 Then
Cells(lngRow + 2, rh + 1).Cut
Cells(lngRow + 5, rh + 1).Insert Shift:=xlDow
End If
If Cells(lngRow + 1, 8).Value = Cells(lngRow + 3, 8).Value And Cells(lngRow + 3, 8).Value > 0 Then
Cells(lngRow + 3, rh + 1).Cut
Cells(lngRow + 5, rh + 1).Insert Shift:=xlDown
End If
If Cells(lngRow + 2, 8).Value = Cells(lngRow + 3, 8).Value And Cells(lngRow + 4, 8).Value > 0 Then
Cells(lngRow + 3, rh + 1).Cut
Cells(lngRow + 6, rh + 1).Insert Shift:=xlDown
End If
Next rh
Next lngRow
Schaut zwar genauso Schi.... aus,funktioniert aber,lach
Darüber noch eine Schlefe das ich nicht zigmal das makro ausführen muss um alles so zu setzen wie es sein soll.
kann jemand helfen?
mfg-wothan-
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige