Сортировка VBA, создающая диапазон из большой формулы - PullRequest
0 голосов
/ 22 октября 2018

Я хочу отсортировать столбец по алфавиту (E), но мне нужно изменить значения в моих столбцах, чтобы алфавитный порядок был правильным, например: у меня есть R1, R2, R3 ... R100, CN1, CN10и т.д ... По алфавиту R100 идет перед R2.Итак, у меня есть очень большая формула со встроенными If, Concatenates и т. Д. Для добавления нулей буфера (R001, R002, R100, CN001, ...)

Прямо сейчас мой макрос добавляет столбец с моимформула (R1C1), сортировка таблицы по этому новому столбцу, затем удаление столбца.

Я новичок в VBA и мне интересно, как я могу создать диапазон из этой формулы, и сортировать напрямую мой правильный столбециз этого нового диапазона.

(как бы я создал этот диапазон из другого моего диапазона, не сохраняя его в другом столбце?)

Например:

ActiveWorkbook.Worksheets("sheet1").Select

Columns("E:M").Sort key1:=CREATED_RANGE, order1:=xlAscending, Header:=slYes

Моя формула для отступа 000:

= IF (ISBLANK (E2) = FALSE, IF (ISERROR (VALUE (RIGHT (E2,3)))) = FALSE, E2, IF (AND (ISERROR)(ЗНАЧЕНИЕ (MID (E2,2,1))) = TRUE, ЕОШИБКА (ЗНАЧЕНИЕ (ПРАВЫЙ (E2,2))) = FALSE), СЦЕПИТЬ (ЛЕВЫЙ (E2,2), 0, ПРАВЫЙ (E2,2)), IF ((И (ISERROR (VALUE (MID (E2,2)))) = FALSE, ISERROR (VALUE (RIGHT (E2,2))) = FALSE)), CONCATENATE (LEFT (E2,1), 0, ПРАВЫЙ (E2,2)), ЕСЛИ (ЕОШИБКА (ЗНАЧЕНИЕ (MID (E2,2,1))) = TRUE, СЦЕПИТЬ (ЛЕВЫЙ (E2,2), "00", RIGHT (E2,1)), CONCATENATE (LEFT (E2,1), "00", RIGHT (E2,1)))))), "")

1 Ответ

0 голосов
/ 22 октября 2018

@ AriB try:

Option Explicit

Sub test()

Dim i As Long
Dim Lastrow As Long
Dim InputString As String

With Sheet1 '<= Let as assume that the data appears in Sheet1

    Lastrow = .Range("A" & Rows.Count).End(xlUp).Row '<= Let as assume that the data appears in Column A

    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove '<= Insert two columns for String & Number Part after column A
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    For i = 1 To Lastrow

        InputString = .Range("A" & i).Value

        If IsNumeric(Mid(InputString, 2, 1)) Then '<= check if only character 1 is letter
            .Range("A" & i).Offset(0, 2).Value = Mid(InputString, 2, (Len(InputString) - 1)) '<= Extract number from InputString and import it on third column
            .Range("A" & i).Offset(0, 1).Value = Mid(InputString, 1, 1) '<= Extract string from InputString and import it on third column
        ElseIf IsNumeric(Mid(InputString, 3, 1)) Then '<= check if only the first two characters are letters
            .Range("A" & i).Offset(0, 2).Value = Mid(InputString, 3, (Len(InputString) - 2))
            .Range("A" & i).Offset(0, 1).Value = Mid(InputString, 1, 2)
        ElseIf IsNumeric(Mid(InputString, 4, 1)) Then '<= check if only the first three characters are letters
            .Range("A" & i).Offset(0, 2).Value = Mid(InputString, 4, (Len(InputString) - 3))
            .Range("A" & i).Offset(0, 1).Value = Mid(InputString, 1, 3)
        End If
    Next i

    Range("A1:C" & Lastrow).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B1:B" & Lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '<= sort with String
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("C1:C" & Lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '<= sort with Number
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:C" & Lastrow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Columns("B:C").Select '<= Select the two columns added to keep String & Number
    Selection.Delete Shift:=xlToLeft

End With

End Sub

Помните, что вы должны изменить лист, диапазон или столбцы, если ваши данные не отображаются в столбце sheet1 A.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...