☰

Код VBA Excel для автоматического форматирования текста (номеров кредитных карт) на основе длины строки?

tag-icon • tag-icon microsoft-excel vba
Код VBA Excel для автоматического форматирования текста (номеров кредитных карт) на основе длины строки?

Фон:

  1. В ячейках с числовым форматированием в Excel цифры после 15-й заменены на нули (причина). Это поведение влияет на запись номеров кредитных карт, которые могут быть длиннее 15 цифр. Обход этого поведения в Excel заключается в форматировании ячеек, которые будут содержать номера кредитных карт (до ввода данных), как строк, а не чисел.
  2. Чтобы отобразить эту строку в более удобном для пользователя формате, я добавляю вспомогательный столбец, который берет строку и разбивает ее на части.
  3. Я делаю это, проверяя длину строки, и если она составляет 16 символов, я разбиваю ее на части 4 4 4 4 (канадская VISA/MC), а если она составляет 15 цифр, я разбиваю ее на части 3 6 5 (канадская Amex).

Образец моей таблицы

Формула, которую я использую для фрагментации вспомогательного столбца

Вопрос:
Можете ли вы адаптировать мой код рабочего листа для VBA, чтобы динамически применять нужный формат к столбцу, содержащему строки моей кредитной карты, при каждом изменении данных?

Моя таблица после добавления запрошенного кода VBA

решение1

Во-первых, вам определенно понадобится текстовый формат в вашем столбце B. Потому что в противном случае Excel сделает свое дело до этого кода, поэтому код не сможет надежно выполнять работу.

Затем вам придется открыть окно VBA и открыть модуль рабочего листа, который вы хотите обновить автоматически. Вставьте внутрь этого модуля этот код:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  Dim rIntersect As Range
  On Error GoTo errH
  Application.EnableEvents = False
  Set rIntersect = Intersect(Me.Range("Table1[Text]"), Target)
  If Not rIntersect Is Nothing Then
    For Each c In rIntersect
      If IsNumeric(c.Value) Then
        If Len(c.Value) = 14 Then
          c.Value = Format(c.Value, "@@@ @@@@@@ @@@@@")
        ElseIf Len(c.Value) = 16 Then
          c.Value = Format(c.Value, "@@@@ @@@@ @@@@ @@@@")
        End If
      End If
    Next
  End If
errH:
  Application.EnableEvents = True
End Sub

(Спасибо,@Рон, для направления к Formatфункции.)

В-третьих, обновите имя таблицы Table1в коде, указав фактическое имя таблицы.

Worksheet_Changeэтособытиекоторый срабатывает каждый раз, когда что-то меняется в рабочем листе. В этом коде мы сначала убеждаемся, что что-то изменилось именно в столбце номера кредитной карты, и только в этом случае начинаем проверять длину и изменять значения.

Связанный контент