VBA的一个简单小程序,输入序列号,查找其在Excel中的信息

Dim shtInvoice As Worksheet
Dim strInput As String

'出货
Sub GetStrInvoice(ByVal strSN As String, ByVal intIndex As Integer)
    Set shtInvoice = Worksheets("出货")        ' 定义sheet表单的对象
    Set shtSheet1 = Worksheets("Sheet1")
    Dim isGotIt As Boolean
    isGotIt = False
    For i = 1 To shtInvoice.Rows.Count
        For j = 1 To shtInvoice.Columns.Count
            If shtInvoice.Cells(i, j).Value = strSN Then
                isGotIt = True
                'strInfo = strInfo & "方向:销售出库 "
                'strInfo = strInfo & "条码:" & shtInvoice.Cells(i, j).Value & " "      ' 某个单元格的值
                'strInfo = strInfo & "行号:" & i & " " & vbCrLf
                'strInfo = strInfo & shtInvoice.Cells(i, 1) & " " & shtInvoice.Cells(i, 2) & " " & shtInvoice.Cells(i, 3) & " " & shtInvoice.Cells(i, 4) & " " & shtInvoice.Cells(i, 5) & " " & vbCrLf
                shtSheet1.Cells(intIndex, 1) = i
                shtSheet1.Cells(intIndex, 2) = shtInvoice.Cells(i, j).Value         '修改某个单元格的值

                shtSheet1.Cells(intIndex, 3) = shtInvoice.Cells(i, 1).Value
                shtSheet1.Cells(intIndex, 4) = shtInvoice.Cells(i, 2).Value
                shtSheet1.Cells(intIndex, 5) = shtInvoice.Cells(i, 3).Value
                shtSheet1.Cells(intIndex, 6) = shtInvoice.Cells(i, 4).Value
                shtSheet1.Cells(intIndex, 7) = shtInvoice.Cells(i, 5).Value
            End If
            If isGotIt Then
                Exit For
            End If
        Next j
        If isGotIt Then
            Exit For
        End If
    Next i
End Sub

Sub ClearAll()
    Set shtSheet1 = Worksheets("Sheet1")
    For i = 2 To 2000
        For j = 1 To 7
            shtSheet1.Cells(i, j).Value = ""
        Next j
    Next i
End Sub

Function FormateStringToComa(ByVal strInput As String) As String
    Dim strResult As String
    strResult = Replace(strInput, Chr$(10) & "", ",")   '这个是换行
    strResult = Replace(strResult, Chr$(13) & "", ",")   '这个是回车
    strResult = Replace(strResult, Chr$(9) & "", ",")   '水平制表符
    strResult = Replace(strResult, Chr$(11) & "", ",")   '制表符
    strResult = Replace(strResult, Chr$(32) & "", ",")   '空白

    FormateStringToComa = strResult
End Function

Private Sub btnQuery_Click()
    Call ClearAll
    Dim giantString As String
    strSNs = tbInput.Value
    strSNs = FormateStringToComa(strSNs)
    'Set lstSNs = Split(strSNs, ",")
    Dim intIndex As Integer
    intIndex = 2
    For Each strTemp In Split(strSNs, ",")
        If strTemp <> "" Then
            intIndex = intIndex + 1
            Call GetStrInvoice(strTemp, intIndex)
        End If
    Next
    MsgBox "查询成功!请到Sheet1中查看"
    Unload Me
End Sub

Private Sub UserForm_Click()

End Sub

posted on 2010-11-23 13:27  冰危节奏  阅读(2916)  评论(0)    收藏  举报

导航