2 spalten vergleichen und werte ausrichten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Einfuegen() Dim iLeft As Integer, iRight As Integer, iCol As Integer, iCount As Integer iCount = 5 iCol = ActiveCell.Column Range(Cells(1, iCol), Cells(1, iCol + iCount - 1)).EntireColumn.Insert iCol = iCol + iCount + 1 Range(Cells(1, iCol), Cells(1, iCol + iCount - 1)).EntireColumn.Insert End Sub

Sub Ausrichten() Dim i%, j%, intA%, intB% i = 1 Do intA = CInt(Cells(i, 1).Value) intB = CInt(Cells(i, 2).Value) j = 0 If intA < intB Then j = 2 ElseIf intA > intB Then j = 1 End If If j <> 0 Then Cells(i, j).Insert Shift:=xlDown i = i + 1 Loop Until IsEmpty(Cells(i, 1).Value) Or IsEmpty(Cells(i, 2).Value) End Sub

Sub tttt() Dim z1 As Long, z2 As Long z1 = 1 z2 = 1 While Not (IsEmpty(ActiveSheet.Cells(z1, 3)) Or IsEmpty(ActiveSheet.Cells(z2, 4))) If ActiveSheet.Cells(z1, 3) = ActiveSheet.Cells(z2, 4) Then z1 = z1 + 1 z2 = z2 + 1 ElseIf ActiveSheet.Cells(z1, 3) < ActiveSheet.Cells(z2, 4) Then Range(ActiveSheet.Cells(z2, 4), ActiveSheet.Cells(z2, 6)).Insert (xlShiftDown) z1 = z1 + 1 z2 = z2 + 1 Else Range(ActiveSheet.Cells(z1, 1), ActiveSheet.Cells(z1, 3)).Insert (xlShiftDown) z2 = z2 + 1 z1 = z1 + 1 End If Wend End Sub

Hallo zusammen,
und hier nochmal erweitert...
spalte sp1 und sp2 werden verglichen und dann anz-spalten links bzw rechts davon mit verarbeitet.
habe die Werte im Macro fest verdraten, man könnte sie auch im Macro eingeben lassen.
Gruß Ingo
PS eine Rückmeldung wäre nett


Sub tttt()
Dim z1 As Long, z2 As Long
Const sp1 = 3
Const sp2 = 4
Const anz = 3
z1 = 1
z2 = 1
While Not (IsEmpty(ActiveSheet.Cells(z1, 3)) Or IsEmpty(ActiveSheet.Cells(z2, 4)))
If ActiveSheet.Cells(z1, sp1) = ActiveSheet.Cells(z2, sp2) Then
z1 = z1 + 1
z2 = z2 + 1
ElseIf ActiveSheet.Cells(z1, sp1) < ActiveSheet.Cells(z2, sp2) Then
Range(ActiveSheet.Cells(z2, sp2), ActiveSheet.Cells(z2, sp2 + anz - 1)).Insert (xlShiftDown)
z1 = z1 + 1
z2 = z2 + 1
Else
Range(ActiveSheet.Cells(z1, sp1 - anz + 1), ActiveSheet.Cells(z1, sp1)).Insert (xlShiftDown)
z2 = z2 + 1
z1 = z1 + 1
End If
Wend
End Sub

Sub tttt() Dim z1 As Long, z2 As Long Const sp1 = 4 Const sp2 = 5 Const anz = 3 z1 = 1 z2 = 1 While Not (IsEmpty(ActiveSheet.Cells(z1, sp1)) Or IsEmpty(ActiveSheet.Cells(z2, sp2))) If ActiveSheet.Cells(z1, sp1) = ActiveSheet.Cells(z2, sp2) Then z1 = z1 + 1 z2 = z2 + 1 ElseIf ActiveSheet.Cells(z1, sp1) < ActiveSheet.Cells(z2, sp2) Then Range(ActiveSheet.Cells(z2, sp2), ActiveSheet.Cells(z2, sp2 + anz - 1)).Insert (xlShiftDown) z1 = z1 + 1 z2 = z2 + 1 Else Range(ActiveSheet.Cells(z1, sp1 - anz + 1), ActiveSheet.Cells(z1, sp1)).Insert (xlShiftDown) z2 = z2 + 1 z1 = z1 + 1 End If Wend End Sub

Option Explicit Sub Sort_insert() Dim zz As Long Const lngS = 12 ' Schnittstelle nach der 12. Spalte zz = 1 Do If Cells(zz, lngS) < Cells(zz, lngS + 1) Then Range(Cells(zz, lngS + 1), Cells(zz, 256)).Insert xlShiftDown ElseIf Cells(zz, lngS) > Cells(zz, lngS + 1) Then Range(Cells(zz, 1), Cells(zz, lngS)).Insert xlShiftDown End If zz = zz + 1 Loop Until IsEmpty(Cells(zz, lngS)) Or IsEmpty(Cells(zz, lngS + 1)) End Sub

Option Explicit Sub Sort_insert() Dim lngS As Integer, zz As Long lngS = ActiveCell.Column ' Schnittstelle nach der aktiven Spalte zz = 1 Do If Cells(zz, lngS) < Cells(zz, lngS + 1) Then Range(Cells(zz, lngS + 1), Cells(zz, 256)).Insert xlShiftDown ElseIf Cells(zz, lngS) > Cells(zz, lngS + 1) Then Range(Cells(zz, 1), Cells(zz, lngS)).Insert xlShiftDown End If zz = zz + 1 Loop Until IsEmpty(Cells(zz, lngS)) Or IsEmpty(Cells(zz, lngS + 1)) End Sub

Beliebteste Forumthreads (12 Monate)

2 spalten vergleichen und werte ausrichten

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2 spalten vergleichen und werte ausrichten

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread