Finde alle Nummern in bestimmten Intervallen [Min; Max] und schreibe sie in eine Spalte

Question

Ich habe ein Problem mit einer bestimmten Excel-Aufgabe. Obwohl ich das Internet gründlich nach Tipps und Teilen von Code durchforstete, die ich verwenden konnte, war ich nicht in der Lage, eine funktionierende Lösung zu finden.

Das ist mein Problem:

Ich habe rund 30 Arbeitsblatt mit zwei Spalten je. Die Anzahl der Zeilen variiert von WS zu WS, aber die beiden Spalten auf jedem Blatt sind gleich lang.
Die erste Spalte jedes Blattes enthält Mindestwerte und die zweite Spalte enthält die jeweiligen Maximalwerte.
Zum Beispiel

| A | B 
1 | 1000 | 1010 
2 | 2020 | 2025 

Jetzt brauche ich eine einzige Spalte mit allen Werten aus diesen Intervallen einschließlich der Max- und Min-Werte.

bevorzugte Lösung in Spalt C:
1000 1001, 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 2020 2021 2022 2023 2024 2025

I dachte daran, die zwei Spalten hervorzuheben und dann ein Makro zu aktivieren, um die Liste zu generieren. Ich würde dann diesen Prozess für jeden WS manuell wiederholen. Einige Blätter haben nur 4 bis 20 Reihen, aber einige haben mehr als 7000 Reihen.
Und wenn es irgendwas hilft: Die Nummern sind Postleitzahlen ;-)

Ich wäre sehr dankbar für jede Art von Hilfe.

Vielen Dank im Voraus!

Answer 1

Try this:

Sub Test() 
    Dim LastRow As Long, ColIndex As Long 
    Dim i As Long, j As Long 
    Dim min As Long, max As Long 
    Dim ws As Worksheet 

    For Each ws In ActiveWorkbook.Worksheets 
     LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
     ColIndex = 1 
     For i = 1 To LastRow 
      min = ws.Cells(i, 1).Value 
      max = ws.Cells(i, 2).Value 
      For j = min To max 
       ws.Cells(ColIndex, 3).Value = j 
       ColIndex = ColIndex + 1 
      Next j 
     Next i 
    Next ws 
End Sub 

Answer 2

Eine Lösung können Sie verwenden, wie Sie ein bisschen wie das wäre mag:

Public Function getZIPs(rng As Range) As String 
    Dim myVal As Variant, str As String, i As Long, j As Long 
    myVal = Intersect(rng, rng.Parent.UsedRange).Value 

    For i = 1 To UBound(myVal) 
    If IsNumeric(myVal(i, 1)) And IsNumeric(myVal(i, 2)) And Len(myVal(i, 1)) > 0 And Len(myVal(i, 2)) > 0 Then 
     If myVal(i, 1) <= myVal(i, 2) Then 

     For j = myVal(i, 1) To myVal(i, 2) 
      str = str & ", " & j 
     Next 

     End If 
    End If 
    Next 

    getZIPs = Mid(str, 3) 
End Function 

Setzen Sie dieses in ein Modul und dann entweder gehen für C1: =getZIPs(A1:B1) und Auto fill down oder direkt =getZIPs(A:B), um alle Zahlen in einer Zelle zu bekommen oder sie in einem Sub zu benutzen, um es automatisch zu machen.

Wenn Sie Fragen haben, fragen Sie einfach :)

EDIT:

Wenn Sie es genau in der one-column-Wege möchten, können Sie diese verwenden (sollte schnell sein):

Sub getMyList() 

    Dim sCell As Range, gCell As Range 
    Set gCell = ActiveSheet.[A1:B1] 
    Set sCell = ActiveSheet.[C1] 

    Dim sList As Variant 

    While IsNumeric(gCell(1)) And IsNumeric(gCell(2)) And Len(gCell(1)) > 0 And Len(gCell(2)) > 0 

    If gCell(1) = gCell(2) Then 
     sCell.Value = gCell(1) 
     Set sCell = sCell.Offset(1) 
    Else 
     sList = Evaluate("ROW(" & gCell(1) & ":" & gCell(2) & ")") 
     sCell.Resize(UBound(sList)).Value = sList 
     Set sCell = sCell.Offset(UBound(sList)) 
    End If 

     Set gCell = gCell.Offset(1) 

    Wend 

End Sub 

Wenn Sie Fragen haben, fragen Sie einfach;)

Answer 3

bearbeitet: haben eine große Zeichenfolge in der Spalte "C" (hinzugefügt zwei Zeilen in jedem Code)

bearbeiten 2: added "Zip3" Lösung für alle Werte in "C" Spalte nur

Sie verwenden entweder könnten aufgelistet mit folgenden Möglichkeiten

Option Explicit 
Sub zips3() 
    'list values in column "C" in sequence from all min to max in columns "A" and "B" 
    Dim sht As Worksheet 
    Dim cell As Range 

    For Each sht In ThisWorkbook.Sheets 
     For Each cell In sht.Range("A1:A" & sht.Cells(sht.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 
      With cell.End(xlToRight).Offset(, 2).Resize(, cell.Offset(, 1).Value - cell.Value + 1) 
       .FormulaR1C1 = "=RC1+COLUMN()-4" 
       sht.Range("C" & sht.Cells(sht.Rows.Count, "C").End(xlUp).Row).Offset(1).Resize(.Columns.Count) = Application.Transpose(.Value) 
       .ClearContents 
      End With 
     Next cell 
     If IsEmpty(sht.Range("C1")) Then sht.Range("C1").Delete (xlShiftUp) 
    Next sht 
End Sub 


Sub zips() 
    'list values in column "C" from corresponding min to max in columns "A" and "B" 
    Dim sht As Worksheet 
    Dim cell As Range 
    Dim j As Long 

    For Each sht In ThisWorkbook.Sheets 
     For Each cell In sht.Range("A1:A" & sht.Cells(sht.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 
      For j = cell.Value To cell.Offset(, 1).Value 
       cell.End(xlToRight).Offset(, 1) = j 
      Next j 
      'lines added to have one bg string in column "C" 
      cell.Offset(, 2).Value2 = "'" & Join(Application.Transpose(Application.Transpose(Range(cell.Offset(, 2), cell.Offset(, 2).End(xlToRight)))), ",") 
      Range(cell.Offset(, 3), cell.Offset(, 3).End(xlToRight)).ClearContents 
     Next cell 
    Next sht 
End Sub 

Sub zips2() 
    Dim sht As Worksheet 
    Dim cell As Range 

    For Each sht In ThisWorkbook.Sheets 
     For Each cell In sht.Range("A1:A" & sht.Cells(sht.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 
      cell.End(xlToRight).Offset(, 1).Resize(, cell.Offset(, 1).Value - cell.Value + 1).FormulaR1C1 = "=RC1+COLUMN()-3" 
      'lines added to have one bg string in column "C" 
      cell.Offset(, 2).Value2 = "'" & Join(Application.Transpose(Application.Transpose(Range(cell.Offset(, 2), cell.Offset(, 2).End(xlToRight)))), ",") 
      Range(cell.Offset(, 3), cell.Offset(, 3).End(xlToRight)).ClearContents 
     Next cell 
    Next sht 
End Sub