當前位置:成語大全網 - 新華字典 - Excel 怎麽樣用VBA做訂單錄入

Excel 怎麽樣用VBA做訂單錄入

壹、數據采集系統功能 錄入、保存、查詢、清空、修改

二、兩個界面?

1.數據錄入界面:前臺功能使用界面,實現“錄入、保存、查詢、清空、修改”;

2. 數據存儲界面:後臺實現數據的保存; 錄入界面:

三、實現方法 1. 保存功能 Sub Save() '?

'保存數據 Marco,xiaohou制作,時間2013-9-5 '?

Dim r1, r2, r3 As Range With Sheets("數據存儲")?

Set r2 = .Range("a2", .[a100000].End(xlUp)) End With?

With Sheets("數據錄入") ? Set r1 = .Range("c4:e4, d6:l39")?

If IsEmpty(.Range("c4")) Or IsEmpty(.Range("e4")) Then 'Or IsEmpty(.Range("b7:b41")) 添加科室不為空,未成功 MsgBox ("編碼、名稱為空,不可保存!") ? Else?

Set r3 = r2.Find(.Cells(4, 3), , , 1) If Not r3 Is Nothing Then?

MsgBox ("此編碼已存在,不可保存。如果此信息需要修改,請點擊查詢後再修改")

Else?

Sheets("數據存儲").Rows("2:35").Insert Shift:=xlDown ?

.Range("c6:l39").Copy ?'復制“數據錄入”表體信息?

Sheets("數據存儲").Range("c2:l2").PasteSpecial Paste:=xlPasteValues ? .Range("c4").Copy ?'復制“數據錄入”編碼?

Sheets("數據存儲").Range("a2:a35").PasteSpecial Paste:=xlPasteValues ? .Range("e4").Copy ?'復制“數據錄入”名稱?

Sheets("數據存儲").Range("b2:b35").PasteSpecial Paste:=xlPasteValues ? r1.ClearContents ? '保存數據後,清空錄入界面 ?

.Range("c4").Select End If ? End If End With End Sub

2. 查詢功能 Sub Query() '?

' 查詢篩選 Macro,xiaohou制作,時間2013-9-5 ' '?

Dim Erow As Integer Dim r1, r2 As Range With Sheets("數據錄入") ? Set r1 = .Range("d6:l39") ? Set r2 = .Range("a6:b39")?

Erow = Sheets("數據存儲").[a100000].End(xlUp).Row

r1.ClearContents

'For Each ce In .[a2:x2]?

'If ce <> "" Then ce.Value = "*" & ce & "*" ? '加上通配符*,實現模糊查詢

'Next?

If IsEmpty(.Range("c4")) Or IsEmpty(.Range("e4")) Then

'Or IsEmpty(.Range("b7:b41")) 添加科室不為空,未成功

MsgBox ("編碼、名稱為空,不可查詢!") ? Else?

Sheets("數據存儲").Range("A1:l" & Erow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ .[c3:e4], CopyToRange:=.[A5:l5], Unique:=False?

r2.Borders(xlDiagonalDown).LineStyle = xlNone r2.Borders(xlDiagonalUp).LineStyle = xlNone

r2.Borders(xlEdgeLeft).LineStyle = xlNone

r2.Borders(xlEdgeTop).LineStyle = xlNone

r2.Borders(xlEdgeBottom).LineStyle = xlNone

'r2.Borders(xlEdgeRight).LineStyle = xlNone r2.Borders(xlInsideVertical).LineStyle = xlNone

r2.Borders(xlInsideHorizontal).LineStyle = xlNone

r2.NumberFormatLocal = ";;;"

'For Each ce In .[a2:x2]?

'If ce <> "" Then ce.Value = Mid(ce, 2, Len(ce) - 2) ? '取消 "*"通配符 ?

'Next ? End If End With End Sub

3. 更新 Sub Update() '?

'更新 Macro,xiaohou制作,時間2013-9-5 ?

Dim arr, d As Object ?

Dim r As Range ?

Dim lr&, i&, j% ?

With Sheets("數據錄入") '查詢修改工作表數據區域寫入數組arr ?

'arr = .Range("A7:D" & .Range("A65536").End(xlUp).Row) ?

arr = .Range("a6:l39") ?

Set r = .Range("d6:l39") ?

End With?

Set d = CreateObject("scripting.dictionary") '定義字典對象 ?

For i = 1 To UBound(arr) '逐行?

'If Len(arr(i, 2)) <> 0 Then '排出“合計”行,即:姓名務數據?

If Not d.exists(arr(i, 1) & arr(i, 2) & arr(i, 3)) Then d(arr(i, 1) & arr(i, 2) & arr(i, 3)) = arr(i, 4) & Chr(9) & arr(i, 5) _?

& Chr(9) & arr(i, 6) & Chr(9) & arr(i, 7) & Chr(9) & arr(i, 8) & Chr(9) & arr(i, 9) & Chr(9) & arr(i, 10) & Chr(9) & arr(i, 11) & Chr(9) & arr(i, 12)

'上壹句:如果編碼和名稱連接字符串字典不存在(首次出現,這裏判斷可能多余),這個字符串添加到字典鍵值,後續的相關屬性字段用制表符連接添加到字典條目

'End If ?Next?

?With Sheets("數據存儲")?

?lr = .Range("A100000").End(xlUp).Row '數據存儲工作表數據行數?

'.Range("C2:D" & lr).SpecialCells(xlCellTypeConstants, 23).ClearContents '清除C、D列不含公式單元格的值?

arr = .Range("A2:l" & lr) '數據存儲工作表數據區域寫入數組arr ?

For i = 1 To UBound(arr) '逐行?

If d.exists(arr(i, 1) & arr(i, 2) & arr(i, 3)) Then '如果編碼和名稱連接字符串字典存在,即Sheet2中有

For j = 4 To 12 'D、E、F...列逐列?

'If Not Cells(i, j).HasFormula Then Cells(i, j) = Split(d(arr(i, 1) & arr(i, 2)), Chr(9))(j - 3)

'上句:如果單元格不含公式,把Sheet2對應的數據寫入這個單元格

.Cells(i?+?1,?j)?=?Split(d(arr(i,?1)?&?arr(i,?2)?&?arr(i,?3)),?Chr(9))(j?-?4)?

Next?

End?If?

Next?

End?With?

r.ClearContents?

Sheets("

數據錄入

").Cells(4,?3).Select?

MsgBox?("

數據已更新完成,若要查看更新後的內容,請點擊按鈕查詢")