Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zahlenintervalle auflösen

Zahlenintervalle auflösen
12.03.2023 13:56:20
Uwe
Hallo,
in einer mir vorliegenden Excel Datei sind Intervall-Werte in den Spalte A und B definiert.
Spalte A Zeile 2 = 1.000, Spalte B Zeile 2 = 1.003
Spalte A Zeile 3 = 2.009, Spalte B Zeile 3 = 2.013
Spalte A Zeile 4 = 4.001
Spalte A Zeile 5 = 7.008, Spalte B Zeile 5 = 7.015
In der Spalte C sind je Intervall unterschiedliche Merkmale hinterlegt. Bspw. C2 = Auto; C3 = Bus, C4 = Motorrad usw.
Die Tabelle hat mehrere hundert Intervalle, vereinzelt können auch nur Einzelwerte in Spalte A vorkommen. Die Spalte B ist dann leer.
Nun möchte ich über ein Makro die Intervalle auflösen, damit ich alle Einzelwerte aus den Intervallen (Spalte A und B) in einer neuen Tabelle untereinander stehen habe. Das Merkmal aus Spalte C sollte in der danbenstehenden Spalte mit angegeben werden.
Das Ergebnis kann wie folgt aussehen (neues Tabellenblatt)

A2 = 1.000; B2 =Auto
A3 = 1.001; B3 =Auto
A4 = 1.002; B4 =Auto
A5 = 1.003; B5 =Auto
A6 = 2.009; B6 =Bus
A7 = 2.010; B6 =Bus
ff.
A11 = 4.001; B11 =Motorrad
A12 = 7.008; B12 =Fahrrad
ff
Es wäre super, wenn mir jemand helfen kann.
Danke und viele Grüße
Uwe

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

Betreff
Datum
Anwender
Anzeige
AW: Zahlenintervalle auflösen
12.03.2023 14:20:24
GerdL
Hallo Uwe!
Sub Unit()
    Dim wksQuelle As Worksheet
    Dim wksZiel As Worksheet
    
    Set wksQuelle = Worksheets("Tabelle1")
    Set wksZiel = Worksheets("Tabelle2")
    
    With wksQuelle.Columns(2).SpecialCells(4)
        Union(.Offset(, -1), .Offset(, 1)).Copy
        wksZiel.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
    
    Set wksZiel = Nothing
    Set wksQuelle = Nothing
End Sub
Gruß Gerd
AW: Zahlenintervalle auflösen
12.03.2023 14:28:15
Nepumuk
Hallo Uwe,
teste mal:
Option Explicit
Public Sub Solve_number_intervals()
    Dim avntValues As Variant
    Dim astrOutput() As String
    Dim ialngIndex As Long, ialngCount As Long
    With Worksheets("Tabelle1")
        avntValues = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).Value2
    End With
    For ialngIndex = LBound(avntValues) To UBound(avntValues)
        If IsEmpty(avntValues(ialngIndex, 2)) Then
            ReDim Preserve astrOutput(1, ialngCount)
            astrOutput(0, ialngCount) = avntValues(ialngIndex, 1)
            astrOutput(1, ialngCount) = avntValues(ialngIndex, 3)
            ialngCount = ialngCount + 1
        End If
    Next
    Worksheets("Tabelle2").Cells(2, 1).Resize(ialngCount, 2).Value = Application.Transpose(astrOutput)
End Sub
Die Namen der Tabellen anpassen!!!
Gruß
Nepumuk
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige