Форматирование нескольких ячеек с буквами и цифрами в VBA - PullRequest
0 голосов
/ 27 февраля 2019

Я пытался решить эту проблему в течение некоторого времени, но безрезультатно.

У меня есть файл, который отслеживает различные типы счетов.Счета-фактуры имеют как цифры, так и буквы ex.ABC_1234_12345678.Я хочу, чтобы Excel отформатировал коды счетов, добавив нижние баллы после того, как пользователь ввел код счета (без подчеркиваний).В настоящее время у меня есть код, который может сделать это для одной ячейки, но мне было интересно, как я могу изменить его формат, например, выбранное количество ячеекA1-A8.Я добавлю свой код в комментарии.

Спасибо за помощь, буду очень благодарен.:)

Private Sub Worksheet_Change(ByVal Target As Range)     
    Dim rngWatch As Range     
    Dim strOld As String     
    Dim strNew As String

    'What cell is the invoice number in?     
    Set rngWatch = Range("A1")      

    'Did user change it?     
    If Intersect(rngWatch, Target) Is Nothing Then Exit Sub      

    strOld = rngWatch.Value      

    'Are there already hypens?     
    If Len(strOld) = Len(Replace(strOld, "_", "")) Then strNew = Left(strOld, 3) & "_" & Mid(strOld, 4, 3) & "_" & Mid(strOld, 8)          

    'Turn this off for the momenet                                 
    Application.EnableEvents = False                         
    rngWatch.Value = strNew         
    Application.EnableEvents = True     
  End If 
End Sub 

Ответы [ 2 ]

0 голосов
/ 27 февраля 2019

Это может зависеть от того, как вы хотите, чтобы код работал.Например, вы можете создать макрос, который обрабатывает все ячейки в определенном диапазоне после его запуска, что для меня является разумным способом сделать это.Вы можете заставить макрос обрабатывать только выбранные ячейки, что является еще одним вариантом.Есть много способов сделать это.

Я взял ваш пример кода и настроил его так, чтобы обрабатывались любые корректировки ячеек в пределах именованного диапазона _MyNamedRange.Просто введите один и тот же код в более чем 1 ячейку, он просматривает пересечение с помощью цикла for, но вы можете избавиться от этого в зависимости от того, как вы видите работу своего листа.Вам нужно будет создать именованный диапазон _MyNamedRange, в котором будет работать макрос.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngWatch As Range
    Dim strOld As String
    Dim strNew As String
    Dim rngCell As Range, rngInter As Range

    'What cell is the invoice number in?
    Set rngWatch = Range("_MyNamedRange")

    'Get intersect of the change
    Set rngInter = Intersect(rngWatch, Target)

    'Exit of the change does not intersect with the named range
    If rngInter Is Nothing Then Exit Sub

    'Scan through the intersect cells and adjust the cells
    Application.EnableEvents = False
    For Each rngCell In rngInter
        strOld = rngCell.Value

        'Are there already hypens?
        strNew = ""
        If Len(strOld) = Len(Replace(strOld, "_", "")) Then strNew = Left(strOld, 3) & "_" & Mid(strOld, 4, 3) & "_" & Mid(strOld, 8)

        'Update the cell
        rngCell.Value = strNew

    Next rngCell
    Application.EnableEvents = True

End Sub
0 голосов
/ 27 февраля 2019

Расширьте ваш rngWatch:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngWatch As Range, r As Range
    Dim strOld As String
    Dim strNew As String

    'What cell is the invoice number in?
    Set rngWatch = Range("A:A")

    'Did user change it?
    If Intersect(rngWatch, Target) Is Nothing Then Exit Sub
    For Each r In Intersect(Target, rngWatch)
        strOld = r.Value

        'Are there already hypens?
        If Len(strOld) = Len(Replace(strOld, "_", "")) Then
            strNew = Left(strOld, 3) & "_" & Mid(strOld, 4, 3) & "_" & Mid(strOld, 8)

            'Turn this off for the momenet
            Application.EnableEvents = False
                r.Value = strNew
            Application.EnableEvents = True
        End If
  Next r
End Sub

Примечание:

Мы используем цикл на случай, если пользователь изменит несколько ячеек в столбце A одновременно через Копировать / Вставить .

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