Справка VBA в Excel
Как мне написать VBA, который предоставит мне диапазоны почтовых индексов на основе следующего:
Нужный результат
Замечательный человек дал мне следующее, но он делает новую строку для каждого почтового индекса, и мне нужно, чтобы он делал только новую строку, если номер зоны изменится.
Sub try_this()
Dim y As Long, lastrow As Long, sht As Worksheet
Set sht = Worksheets("put_your_sheet_name_here") 'change this
'get last row
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For y = 1 To lastrow - 1
With sht.Cells(y, 1)
'create range in 3rd column
.Offset(0, 2).Value = .Value & "-" & .Offset(1, 0).Value - 1
'copy range name to 4th column
.Offset(0, 3).Value = .Offset(0, 1).Value
End With
Next
End Sub
VBA выше — это то, что я пробовал. Если вы знаете, как это можно сделать по-другому, я внимательно слушаю.
Что меня смущает, так это второй экземпляр 1 во второй таблице. Это ошибка?
Нет. Вот где новый почтовый индекс имеет новую зону 1. Я беру 44 000 почтовых индексов США, которые могут иметь разные зоны в зависимости от почтовых индексов, и диапазоны не будут иметь точного повторения. В этом случае следующая строка будет 01200-x — зона 2.
Ответы 3
Мое предложение с кодом VBA. Данные считываются из Worksheets(1), результаты помещаются в Worksheets(2).
Sub try_new()
Dim y As Long, lastrow As Long, sht As Worksheet
Set sht = Worksheets(1) ' Worksheets("put_your_sheet_name_here")
'get last row
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Dim coll As New Collection, addok As Boolean
For y = 1 To lastrow
'verify next zone number
addok = False
If y = 1 Then
addok = True
ElseIf sht.Cells(y, 2).Value <> sht.Cells(y - 1, 2).Value Then
addok = True
End If
If addok Then
'add to collection
coll.Add sht.Cells(y, 1).Resize(, 2).Value
End If
Next y
'read the collection and produce results
Dim sht2 As Worksheet
Set sht2 = Worksheets(2)
sht2.Cells(1, 1).CurrentRegion.Clear
For y = 1 To coll.Count - 1
'create range in columns A:B of sht2
sht2.Cells(y, 1).Value = coll(y)(1, 1) & " - " & Format(coll(y + 1)(1, 1) - 1, "00000")
sht2.Cells(y, 2).Value = coll(y)(1, 2)
Next y
End Sub
Это также можно сделать с помощью Power Query, доступного в Windows Excel 2010+ и Excel 365 (Windows или Mac).
Использование Power Query
- Выберите какую-нибудь ячейку в таблице данных.
Data => Get&Transform => from Table/Range- Когда откроется редактор PQ:
Home => Advanced Editor - Запишите имя таблицы в строке 2.
- Вставьте M-код ниже вместо того, что вы видите.
- Измените имя таблицы в строке 2 обратно на то, что было создано изначально.
- Прочтите комментарии и изучите
Applied Steps, чтобы понять алгоритм.
let
//Change next line to reflect actual data source
//Assumes zip codes are entered as text strings
// if they are formatted numbers, some changes will be required
Source = Excel.CurrentWorkbook(){[Name = "ZipZones"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Zip", type text}, {"Zone", Int64.Type}}),
//Group by Zone, but using GroupKind.Local to group by each change of zone
// and return the minimum Zip code in each zone
// Assumes zip codes are sorted ascending within each zone as you show.
#"Grouped Rows" = Table.Group(#"Changed Type", {"Zone"}, {{"Range", each List.Min([Zip]), type nullable text}},GroupKind.Local),
//Create and add the Zip Range for each Zone
#"Add Zip Range" = Table.FromColumns(
let
zipRange = List.Generate(
()=>[z=#"Grouped Rows"[Range]{0} & Number.ToText(Number.From(#"Grouped Rows"[Range]{1}) - 1,"-00000"), idx=0],
each [idx] < Table.RowCount(#"Grouped Rows")-1,
each [z=#"Grouped Rows"[Range]{[idx]+1} & Number.ToText(Number.From(#"Grouped Rows"[Range]{[idx]+2}) - 1,"-00000"), idx=[idx]+1],
each [z]),
zone = List.RemoveLastN(#"Grouped Rows"[Zone],1)
in
{zipRange} & {zone}, type table[Range=text, Zone=Int64.Type])
in
#"Add Zip Range"
Рон, ты мой золотой бог. ЭТО СРАБОТАЛО! СПАСИБО!!!!
@NancySellers Рада помочь. Если мой ответ соответствует вашим требованиям, отметьте его как Принято. См. Что мне делать, когда кто-то отвечает на мой вопрос.
Вот еще один способ добиться желаемого результата с помощью формул Excel, применимых к MS365:
=LET(
_Data, A2:B7,
_Zip, TAKE(_Data,,1),
_Zone, TAKE(_Data,,-1),
_NZone, SCAN(0,_Zone=DROP(VSTACK("",_Zone),-1),LAMBDA(r,c,IF(c,r,r+1))),
_SZip, XLOOKUP(_NZone,_NZone,_Zip),
_EZip, INDEX(_Zip,XMATCH(XLOOKUP(_NZone,_NZone,_Zip,,,-1),_Zip)+1)-1,
UNIQUE(DROP(HSTACK(TOCOL(BYROW(HSTACK(_SZip,_EZip),LAMBDA(x,
TEXTJOIN("-",,BASE(x,10,5)))),2),_Zone),-1)))
Пожалуйста, отредактируйте свой вопрос, чтобы показать, что вы пробовали и где у вас возникла проблема. И почему ВБА? Вы также можете сделать это с помощью формул или Power Query.