Question

我正在尝试格式化一些数字，其中一些数字带有前导零，以便我可以搜索它们。

我需要格式化一组数字，所有数字均为6位数字，而某些数字前导零。然后，我有一个单独的代码在这些数字中搜索特定的数字，因此需要可搜索到的格式。下面的第一个代码是我无法弄清楚的格式，然后是搜索代码。如果我只是对格式进行“ 000000”格式化，那么我认为它现在不再适用于我的搜索，因为现在这些格式已成为“特殊”格式。请帮忙吗？

Sub (First Code)

Dim lngLastRow As Long

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("O2:P" & lngLastRow).Select 'specify the range which suits your purpose
With Selection
    Selection.NumberFormat = "General"
    .Value = .Value
End With

Dim SUPLCD As Range
Set SUPLCD = Range("Q2:Q")
With Selection
Selection.NumberFormat = "@"
Selection.Value = Format(Selection, "000000")
End With

End Sub


Sub Worksheet()

 Dim i As Long
    Dim j As Long

    Dim wsCurrent As Worksheet
    Set wsCurrent = ActiveSheet

    Dim wsData As Worksheet
    Dim rngData As Range
    Set wsData = ThisWorkbook.Worksheets("Tempinterior")

    Dim wsTempinterior As Worksheet
    ' Note that .Add will activate the new sheet so we'll
    ' need to reactivate the worksheet that was previously active
    Set wsTempinterior = Worksheets.Add
    wsTempinterior.Name = "copy"

    ' Find the used range in columns A to K and copy over starting
    ' at cell A1 of wsGalreq
    Set rngData = Intersect(wsData.UsedRange, wsData.Range("A:M"))

    ' Copy over the first row containing column headers
    j = 1
    rngData.Rows(1).Copy Destination:=wsTempinterior.Cells(j, 1)

    For i = 2 To rngData.Rows.Count
        ' Check cell of column 10 of row i and copy if matched
        If rngData.Cells(i, 10).Value = "026572" Or rngData.Cells(i, 10).Value = "435740" Or rngData.Cells(i, 10).Value = "622639" Then
            ' Copy over to wsDalreq from row j
            j = j + 1
            rngData.Rows(i).Copy Destination:=wsTempinterior.Cells(j, 1)
        End If
    Next

End Sub

使用上述代码，搜索不会提取具有我认为的数字的条目，因为它们的格式设置为特殊。

Answer 1

首先避免使用.Select，然后您需要循环进行更改：

Sub first()

    Dim lngLastRow As Long

    With Worksheets("Sheet1") 'Change to your sheet

        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        With .Range("O2:P" & lngLastRow) 'specify the range which suits your purpose
            .NumberFormat = "General"
            .Value = .Value
        End With

        Dim SUPLCD As Range
        Set SUPLCD = .Range("Q2:Q" & lngLastRow)

        Dim rng As Range
        For Each rng In SUPLCD
            rng.NumberFormat = "@"
            rng.Value = Format(rng.Value, "000000")
        Next rng

    End With

End Sub

Answer 2

您不必格式化Col Q即可添加0，您可以通过在Like语句中使用If来完成不格式化的任务。因为您不清楚值的位置，所以您正在设置Col Q的格式，但搜索Col J时，我使用了Col Q。

Dim wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Sheet1") '("Tempinterior")

Dim rngData As Range
Set rngData = Intersect(wsData.UsedRange, wsData.Range("A:M"))

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "copy"

    j = 1
    rngData.Rows(1).Copy Destination:=Sheets("copy").Cells(j, 1) 'copy headers for rngData

    For i = 2 To rngData.Rows.Count
        If wsData.Cells(i, 17).Value Like "26572" Or Sheet1.Cells(i, 17).Value = "435740" Or _
        Sheet1.Cells(i, 17).Value = "622639" Then
            j = j + 1
            rngData.Rows(i).Copy Destination:=Sheets("Copy").Cells(j, 1)
        End If
    Next i

End Sub

格式编号，以便能够正确搜索

2 个答案: