Как мне отфильтровать все 12-значные числа в коде?

#excel #vba

Вопрос:

Всем привет и спасибо за ваше время, это мой первый пост, и я полный новичок.

Я пытаюсь отфильтровать любое 12-значное число в столбце, B чтобы позже вырезать их на другом листе с именем PPE .

Как мне написать код для этого? В примере ниже это работает отлично, но только для 243080700547 .

Я также предоставил скриншот.

 I = Worksheets("RAW DATA").UsedRange.Rows.Count
J = Worksheets("PPE").UsedRange.Rows.Count

If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("PPE").UsedRange) = 0 Then J = 0
End If

Set xRg = Worksheets("RAW DATA").Range("C1:C" amp; I)

On Error Resume Next
Application.ScreenUpdating = False

For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "243080700547" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("PPE").Range("A" amp; J   1)
        xRg(K).EntireRow.Delete

        If CStr(xRg(K).Value) = "243080700547" Then
            K = K - 1
        End If

        J = J   1
    End If
Next

Ответ №1:

Вы используете приведение к строке через CStr, поэтому я предполагаю, что значения в столбце C являются истинными числами. В этом случае должно быть достаточно простого больше / меньше, чем.

Работайте снизу вверх, и вы сможете избежать изменения приращения.

 with Worksheets("RAW DATA")

  I = .cells(.rows.count, "C").end(xlup).row
  For K = I To 1 step -1
    If .cells(K, "C").value2 > 99999999999 And  .cells(K, "C").value2 <= 999999999999 Then
        J = J   1
        .rows(K).EntireRow.Copy Destination:=Worksheets("PPE").Range("A" amp; J)
        .rows(K).EntireRow.delete
    End If
  Next K

end with

1. Большое вам спасибо за это, оно отлично сработало, и я использовал это. Единственное изменение, которое я внес в него, заключалось в том, чтобы сделать … Диапазон («A» amp; J) в … Диапазон («A» amp; J 1)

2. Поскольку первая строка была заголовком, и она перезаписывала его.

Ответ №2:

Вместо вашего первого появления

If CStr(xRg(K).Value) = "243080700547" Then

вы можете использовать

If Len(CStr(xRg(K).Value)) = 12 Then

чтобы проверить, имеет ли строка длину 12.

Вопрос: Почему вы проверяете это во второй раз? Вы уже находитесь в If блоке той же (первой) проверки.

Ответ №3:

Вы могли бы использовать фильтр вместо перебора всей даты, что было бы намного быстрее, чем копирование строка за строкой, потому что вы копируете все сразу.

Это сработает и для любых других критериев, вам просто нужно настроить .AutoFilter .

 Option Explicit

Public Sub FilterAndCopy()
    Dim DestRow As Long 'find destination row
    DestRow = Worksheets("PPE").Cells(Worksheets("PPE").Rows.Count, "A").End(xlUp).Row   1

    With Worksheets("RAW DATA").UsedRange
        'filter
        .AutoFilter Field:=3, Criteria1:=">=100000000000", Operator:=xlAnd, Criteria2:="<=999999999999"
        'copy date (without headers)
        .Resize(RowSize:=.Rows.Count - 1).Offset(RowOffset:=1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Worksheets("PPE").Cells(DestRow, "A")
        'remove filter
        .AutoFilter
    End With
End Sub