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

Spalten sortieren

Forumthread: Spalten sortieren

Spalten sortieren
06.05.2015 12:41:33
Simon
Hallo Zusammen
Habe folgendes Problem
Würde gerne 2 Spalten (A&E) zu einer Spalte (I) zusammenfassen. Dabei müssen die Werte in A&E der Reihe nach sortiert und die dazugehörenden Werte (B&F) in J reingeschrieben werden. Die I-Werte sollten 10er Schritte machen d.h. wenn es eine Lücke gibt dann sollen die vorgehenden Werten übernommen werden.
https://www.herber.de/bbs/user/97494.xlsm
Hat jemand ne Idee?
Gruss simon

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten sortieren
06.05.2015 13:49:42
Daniel
Hi
probier mal das:
Sub test()
Range("I:J").ClearContents
Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Range("I1")
Range("E1:F" & Cells(Rows.Count, 5).End(xlUp).Row).Copy Cells(Rows.Count, 9).End(xlUp).Offset(1, _
0)
With Cells(Rows.Count, 9).End(xlUp).Offset(1, 0)
.Value = 10
.DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, _
Step:=10, _
Stop:=WorksheetFunction.RoundUp(WorksheetFunction.Max(.EntireColumn), -1), _
Trend:=False
End With
With Range("I:J")
.RemoveDuplicates 1, xlNo
.sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
End With
With Range("J2:J" & Cells(Rows.Count, 9).End(xlUp).Row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Formula = .Value
End With
End Sub

Gruß Daniel

Anzeige
AW: Spalten sortieren
06.05.2015 14:51:21
UweD
Hallo
so ?
Sub sort()
Dim no As Integer
Dim letzteZT1 As Integer
With ActiveWorkbook.Sheets("Tabelle2")
Range("I:J").ClearContents
letzteZT1 = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:B" & letzteZT1).Copy Range("I1")
letzteZT1 = .Range("I" & Rows.Count).End(xlUp).Row
.Range("E1:F" & letzteZT1).Copy .Range("I" & letzteZT1 + 1)
'sortieren
.sort.SortFields.Clear
.sort.SortFields.Add Key:=Range("I:I"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.sort.SetRange Range("I:J")
.sort.Header = xlNo
.sort.MatchCase = False
.sort.Orientation = xlTopToBottom
.sort.SortMethod = xlPinYin
.sort.Apply
letzteZT1 = .Range("I" & Rows.Count).End(xlUp).Row
For no = letzteZT1 To 2 Step -1
If .Cells(no, 9) - .Cells(no - 1, 9) > 10 Then
Range(Cells(no, 9), Cells(no, 10)).Insert xlDown
.Cells(no, 9) = (Int(.Cells(no + 1, 9) / 10) - 1) * 10
.Cells(no, 10) = .Cells(no - 1, 10)
no = no + 1
ElseIf .Cells(no, 9) = .Cells(no - 1, 9) Then 'doppelt enthalten
Range(Cells(no, 9), Cells(no, 10)).Delete xlUp
End If
Next no
End With
End Sub
Gruß UweD
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige