Создание диапазонов из строк VBA

У меня несколько строк, которые иногда находятся в порядке, а иногда нет. Из строк, которые находятся в порядке, мне нужно будет создать диапазон, который не предназначен для копирования номера.

Дело в том, что большинство строк в порядке может быть даже 20.

Например, ячейки:
1
3
5
6
7
8
9
10
13
14
15

Было бы:
1
3
5-10
13-15

Можно ли его закодировать?

благодаря

Предполагая, что ваши данные начинаются с A1 …. и

требуемые результаты будут напечатаны в столбце C.

Попробуйте использовать код ниже

Sub test() Dim i As Long, lastrow As Long, incre As Long Dim startno As Variant Dim endno As Variant incre = 1 lastrow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastrow If Cells(i, 1) = (Cells(i + 1, 1) - 1) Then startno = Cells(i, 1) Do While Cells(i, 1) = (Cells(i + 1, 1) - 1) endno = Cells(i + 1, 1) i = i + 1 Loop Cells(incre, 3) = "'" & startno & "-" & endno incre = incre + 1 Else Cells(incre, 3) = Cells(i, 1) incre = incre + 1 End If Next i End Sub 

введите описание изображения здесь

если вам нужен адрес всех диапазонов, которые вы могли бы использовать:

 Option Explicit Sub main() Dim rangeStrng As String With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name rangeStrng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas.Parent.Address(False, False) End With End Sub 

если вы хотите только диапазон строк, то вы можете использовать:

 Option Explicit Sub main2() Dim rng As Range Dim rowsRangeStrng As String With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name For Each rng In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas If rng.Rows.Count = 1 Then rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & "," Else rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & "-" & rng.Rows(rng.Rows.Count).Row & "," End If Next rng End With If rowsRangeStrng <> "" Then rowsRangeStrng = Left(rowsRangeStrng, Len(rowsRangeStrng) - 1) End Sub 

Если я правильно понял ваш вопрос, вы не хотите обращаться к диапазону, а хотите получить выходную таблицу. Этот код ниже должен предоставить вам именно это. Мои номера ввода находятся в столбце A, а вывод – в столбце B.

 Sub sequentials() Dim tws As Worksheet Dim tmpRowA, tmpRowB As Integer Dim seq() As Long Dim frA, frB, lrA As Integer 'firstrow col A, col B, lastrow of data Set tws = ThisWorkbook.Worksheets("Sheet1") frA = 2 frB = 2 lrA = tws.Range("A1000000").End(xlUp).Row 'Input in column A, Output in column B 'Headers in Row 1 ReDim seq(0 To lrA - 1) seq(0) = -2 seq(1) = tws.Range("A" & frA).Value tmpRowA = frA tmpRowB = frB tws.Range("B" & frB & ":B" & lrA).NumberFormat = "@" For r = frA + 1 To lrA If r = 23 Then r = 23 End If With tws seq(r - 1) = .Range("A" & r).Value If seq(r - 1) = seq(r - 2) + 1 Then If r = lrA Then .Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 1) End If Else If seq(r - 2) = seq(r - 3) + 1 Then .Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 2) Else .Range("B" & tmpRowB).Value = seq(r - 2) End If tmpRowB = tmpRowB + 1 tmpRowA = r + 1 If r = lrA Then .Range("B" & tmpRowB).Value = seq(r - 1) End If End If End With Next r End Sub 

Доказательство концепции:

Доказательство концепции

  • Выбор всех данных из размера таблицы по умолчанию VBA Excel
  • Проблема с вставкой диапазонов, когда не проходит
  • Выбрать диапазон в конкретном листе в excel vba
  • Выбор нескольких файлов с помощью vb для excel, если часть базового имени файла одинакова
  • Не удается заставить Color Picker работать в Excel 2010 64 Bit
  • datepicker, который работает для Excel 2010/2007/2003
  • Поиск первого и последнего номеров строк из переменной диапазона
  • VBA превращает секторы записанного макроса в нечто более эффективное
  • Обнаружить тип выделения в листе только что отключен
  • выбирать без замены по критериям
  • Код ошибки 1004 на
  • Interesting Posts

    Угол поворота для метки данных вдоль линии на диаграмме

    Сохранение листа Excel в виде xml добавляет кавычки вокруг некоторых строк

    Проблемы с кодировкой для файла CSV UTF8 при открытии Excel и TextEdit

    Excel VBA Update: поиск данных, просмотр нескольких листов, диапазон копирования

    VBA умножает два именованных диапазона

    Расширьте выбор источника данных сводной таблицы до последней строки excel с помощью python и обновите сводную таблицу

    excel row count using asp

    Как добавить отсутствующее время в столбце Excel для интерполяции

    Вычисление точности в пределах excel

    Python: запись в файлы Excel 2007+ (файлы .xlsx)

    Генерация XLSX в .NET – альтернативная библиотека объектов Microsoft Excel

    Как найти значение ячейки в пределах видимого диапазона

    Подсчет экземпляров каждого месяца на основе утверждений IF

    Как автоматически копировать данные из одной книги Excel?

    Я получаю сообщение об ошибке «System.Data.OleDb.OleDbException: внешняя таблица не находится в ожидаемом формате».

    Давайте будем гением компьютера.