如何用VBA实现快速查询并记录系统数据

我初学VBA，但这个问题我可以回答，用ADODB实现

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim Conn As New ADODB.Connection

Dim Rs As New ADODB.Recordset

Dim Str_sql As String

Conn.Open ("provider=microsoft.ace.oledb.12.0extended properties='Excel 12.0HDR=YES'data source=" &ThisWorkbook.FullName)

Str_sql = "SELECT 编号,类别,长度,宽度,库存 FROM [数据表$] WHERE (长度>=" &TextBox1.Value - 1 &" AND 长度<=" &TextBox1.Value + 1 &") AND (宽度>=" &TextBox2.Value - 1 &" AND 宽度<=" &TextBox2.Value + 1 &")"

Rs.Open Str_sql, Conn, adOpenKeyset, adLockReadOnly

If Not Rs.RecordCount = 0 Then

Range("A3:E65536").ClearContents

Range("A3:E65536").Interior.Color = RGB(255, 255, 255)

Range("A3").CopyFromRecordset Rs

Dim A As Long

Dim T1, T2 As Double

T1 = CDbl(TextBox1.Value)

T2 = CDbl(TextBox2.Value)

For A = 3 To Rs.RecordCount + 3

If Cells(A, 3).Value = T1 And Cells(A, 4).Value = T2 Then

Range(Cells(A, 1), Cells(A, 5)).Interior.Color = RGB(169, 208, 142)

End If

Next A

Else

TextBox1.Value = ""

TextBox2.Value = ""

Range("A3:E65536").ClearContents

Range("A3:E65536").Interior.Color = RGB(255, 255, 255)

MsgBox "没有找到合适的刀模！"

End If

Rs.Close

Set Rs = Nothing

Conn.Close

Set Conn = Nothing

Application.ScreenUpdating = True

End Sub

以上代码缺陷在于没有对Textbox1和Textbox2输入的值进行数据验证，这里只能输数字和小数点，如果你输入别的程序就会报错。

在工程资源管理器中双击“ *** 作表”单元格，然后粘贴下列代码进去

Dim DumpData(1 To 10, 1 To 6) As Integer

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim LogSht As Worksheet, iRow As Integer, iColumn As Integer, TrgColmn As Integer, j As Integer

    TrgColmn = Target.Column

    If TrgColmn < 9 Or TrgColmn > 14 Then Exit Sub

    Set LogSht = Worksheets("日志")

    iColumn = 4 * (TrgColmn - 9) + 1

    

    Dim i As Integer

    i = 3

    Do

        If LogSht.Cells(i, iColumn) = "" Then Exit Do

        i = i + 1

    Loop Until False

    LogSht.Cells(i, iColumn) = Now

    LogSht.Cells(i, iColumn + 1) = DumpData(Target.Row - 4, TrgColmn - 8)

    LogSht.Cells(i, iColumn + 2) = Target.Text

    LogSht.Cells(i, iColumn + 3) = Target.Address

    

    For i = 1 To 10

        For j = 1 To 6

            DumpData(i, j) = Cells(i + 4, j + 1)

        Next

    Next

End Sub

第一次变动修改前会出现数据缺失，需人工干预调整

---