首页 > 解决方案 > 格式数字能够正确搜索

问题描述

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

我需要格式化一组数字,其中所有数字都是 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

使用上面的代码,搜索不会提取我认为具有这些数字的条目,因为它们被格式化为特殊格式。

标签: excelvba

解决方案


您无需格式化Col Q即可添加 0,您可以通过LikeIf语句中使用来完成您的任务而无需格式化。因为您不清楚值在哪里,所以您正在格式化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

推荐阅读